perm filename ILISP.DIF[UCI,SYS] blob
sn#076409 filedate 1973-12-11 generic text, type T, neo UTF8
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 1,1
******** ILISP.MAC **** PAGE 1
1) 00050 SUBTTL AC DEFINITIONS AND EXTERNALS --- PAGE 1
1) 00100 TITLE ILISP INTERPRETER
1) 00150 TWOSEG
1) 00200 ;SYSPRG==667 ;PPN OF LISP SYSTEM - SET TO 0 FOR SYS:
*** NEWUCI.MAC *** PAGE 1
2) TITLE LISP INTERPRETER
2) SUBTTL NOTES TO SYSTEM PROGRAMMERS
2) ; ASSEMBLY SWITCHES OF INTEREST
2) ;
2) ; SWITCH EXPLANATION, COMMENTS ETC.
2) ; ALTMOD FOR ALTMODE CHARACTER. OLD WAS 175
2) ; NOW IT'S 33 FOR 506
2) ; QALLOW ENABLES ACCESS TO QMANGR, ONLY IF YOUR
2) ; SYSTEM SUPPORTS QUEUE. SEVERAL SWITCHES
2) ; ASSOCIATED WITH THE CODE
2) ; OLDNIL OLD STANFORD NIL. CODE TO MAKE CAR AND CDR
2) ; OF NIL INCOMPLETE AS OF 8/30/73
2) ; NONUSE OLD STANFORD VERSIONS OF MEMQ, AND ETC.
2) ; THAT RETURNED T OR NIL.
2) ; SYSPRG PROJECT NUMBER IF NOT ON SYS:.
2) ; SYSPN PROGRAMMER NUMBER IF NOT ON SYS:
2) ; SYSDEV DEVICE LOCATION OF SYSTEM.
2) ; NOTE THAT THE ABOVE THREE ARE WHERE LISP
2) ; EXPECTS TO FIND THE LOADER,THE
2) ; SYMBOL TABLE AND THE NORMAL HI-SEGMENT.
2) ; THE FUNCTION (SETSYS ...) ONLY CHANGES THE
2) ; EXPECTED LOCATION OF THE HI-SEG
2) ; **USE FOLLOWING AT OWN RISK**
2) ; HASH NUMBER OF HASH BUCKETS WHEN STARTING
2) ; ALVINE STANFORD EDITOR (WHO WOULD WANT IT?)
2) ; 1 FOR ALVINE, 0 FOR NO ALVINE
2) ; STPGAP ANOTHER STANFORD EDITOR
2) ; COMMENTS
2) ; THERE ARE BASICALLY TWO SETS OF COMMENTS IN THE CODE.
2) ; THOSE IN LOWER CASE ARE ORIGINAL STANFORD COMMENTS.
2) ; THOSE OF A SEMI-COLON FOLLOWED BY TWO $'S,
2) ; TWO #'S, OR TWO %'S ARE UCI ADDITIONS,
2) ; CHANGES, OR ADDITIONAL COMMENTS.
2) ; ($'S ARE USUALLY DARYLE LEWIS,
2) ; #'S ARE GENERALLY JEFF JACOBS,
2) ; AND %'S ARE GENERALLY BILL EARL.)
2) PAGE
2) SUBTTL AC DEFINITIONS AND EXTERNALS
2) TWOSEG
2) OLDNIL==1 ;## NOT COMPLETE
2) IFNDEF NONUSE <NONUSE==0>
2) IFNDEF QALLOW <QALLOW==1>
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 1,1
2) ;SYSPRG==667 ;PPN OF LISP SYSTEM - SET TO 0 FOR SYS:
******** ILISP.MAC **** PAGE 1
1) 00750 STANSW==1 ;1 FOR STANFORD, 0 FOR CHRISTIANS
1) 00800 IFNDEF STANSW,<STANSW==0>
1) 00900 MLON
*** NEWUCI.MAC *** PAGE 1
2) MLON
******** ILISP.MAC **** PAGE 1
1) 01200 DEFINE SYSNAM <SIXBIT /ILISP2/> ; *** MJC
1) 01300 ;accumulator definitions
*** NEWUCI.MAC *** PAGE 1
2) DEFINE SYSNAM <SIXBIT /LISP/>
2) ;accumulator definitions
******** ILISP.MAC **** PAGE 1
1) 03900 OPDEF TALK [PUSHJ P,TTYCLR] ;this is to turn off control O.
1) 03950 ;when ttyser lets you do this
1) 04000 ;easily, change me
1) 04100 ;I/O bits and constants
*** NEWUCI.MAC *** PAGE 1
2) OPDEF SKPINL [TTCALL 14,] ;## BETTER FOR TALK THAN SKPINC
2) OPDEF TALK [PUSHJ P,TTYCLR] ;## TURN OF CONTROL O
2) ;I/O bits and constants
******** ILISP.MAC **** PAGE 1
1) 04850 ALTMOD==175
1) 04900 SPACE==40 ;space
*** NEWUCI.MAC *** PAGE 1
2) IFNDEF ALTMOD,<ALTMOD==33>
2) SPACE==40 ;space
******** ILISP.MAC **** PAGE 1
1) 07100 ;system uuos
*** NEWUCI.MAC *** PAGE 1
2) CNTLR==22 ;CH TO RESTORE SYSTEM OBLIST 3/28/73
2) ;system uuos
******** ILISP.MAC **** PAGE 1
1) 08400 SUBTTL TOP LEVEL AND INITIALIZATION --- PAGE 2
1) 08450 PAGE
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 1,1
1) 08550 SHRST==400000
*** NEWUCI.MAC *** PAGE 1
2) PAGE
2) SUBTTL TOP LEVEL AND INITIALIZATION
2) SHRST==400000
******** ILISP.MAC **** PAGE 1
1) 08800 ; CAME 0,STNIL ;$$UNBIND STACK IF REGS LOOK OK *** MJC
1) 08850 ; JRST GETHGH ;GO GET HIGH SEGMENT *** MJC
1) 08900 ; MOVE B,SC2 *** MJC
1) 08950 ; PUSHJ P,UBD ;$$UNBIND STACK *** MJC
1) 09000 ; JRST STRT ;go to re-allocator *** MJC
1) 09050 ;GETHGH: CALLI RESET *** MJC
1) 09100 ; MOVSI A,1 *** MJC
1) 09150 ;IFE STANSW,< CALLI A,CORE ;ELIMINATE ANY OLD HIGH SEGS. *** MJC
1) 09200 ; HALT > *** MJC
1) 09250 ;*** IFN STANSW,< CALLI A,400015
1) 09300 ;*** HALT>
1) 09350 ;*** MOVEI A,HGHDAT
1) 09400 ;*** CALLI A,GETSEG ;GET THE PROPER HIGH SEG
1) 09450 ;*** HALT
1) 09500 MOVE A,HGHDAT+1 ; Get high segment name *** MJC
1) 09550 CALLI A,400016 ; Attach to high seg if poss. *** MJC
1) 09600 CAIN A,4 ; If err=4 (seg alrdy there) ok too *** MJC
1) 09650 JRST SGPROT ; Success! *** MJC
1) 09750 CALLI 400017 ; Detach stray segments. *** MJC
1) 09800 MOVE A,HGHDAT ; Get device name for OPEN. *** MJC
1) 09850 MOVEM A,INTDAT+1 ; Move into parm list for OPEN. *** MJC
1) 09900 OPEN 0,INTDAT ; Init ch 0 to dump mode. *** MJC
1) 09950 JRST NOSEG ; Couldn't do it? *** MJC
1) 10000 MOVE A,SGPPPN ; Get ppn of high seg file. *** MJC
1) 10050 MOVEM A,HGHDAT+4 ; Store for LOOKUP. *** MJC
1) 10100 LOOKUP 0,HGHDAT+1 ; Find file containing high seg *** MJC
1) 10150 JRST NOSEG ; No high seg file -- collapse *** MJC
1) 10200 HLRE A,HGHDAT+4 ; Ppn was replaced by -length *** MJC
1) 10250 MOVNS A ; Fix up for CORE2. *** MJC
1) 10300 CALLI A,400015 ; Grab core for high segment. *** MJC
1) 10350 JRST NOSEG ; Can't get it? *** MJC
1) 10400 MOVE A,HGHDAT+1 ; Name the high segment. *** MJC
1) 10450 CALLI A,400036 ; SEGNM2 uuo. *** MJC
1) 10500 JRST NOSEG ; Pretty weird. *** MJC
1) 10550 MOVEI A,SHRST-1 ; For dump mode input. *** MJC
1) 10600 HRRM A,HGHDAT+4 ; *** MJC
1) 10650 INPUT 0,HGHDAT+4 ; Fill high seg with goodies. *** MJC
1) 10700 CLOSE 0,1 ; Destroy fingerprints. *** MJC
1) 10750 SGPROT: MOVEI A,DEBUGO ;SET THE REE ADDRESS
1) 10800 HRRM A,JOBREN
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 1,1
1) 10850 MOVE A,HGHDAT+1 ; Decide whether or not to *** MJC
1) 10900 CAME A,[SYSNAM] ; protect segment. *** MJC
1) 10950 JRST STRT ; Segment was not system's *** MJC
1) 11000 CALLI 36 ; Write-protect segment. *** MJC
1) 11050 HALT ; rather than turn him loose. *** MJC
1) 11100 JRST STRT ;GO TO ALLOCATE STORAGE
1) 11150 NOSEG: OUTSTR [ASCIZ/CAN'T GET HIGH SEGMENT!/] ; *** MJC
1) 11200 HALT ; *** MJC
1) 11250 HGHDAT: SYSDEV ; All used by LOOKUP and ENTER *** MJC
1) 11300 SYSNAM ; High segment job & file name *** MJC
1) 11350 0 ; High seg file extension. *** MJC
1) 11400 0
1) 11450 0 ; PRG,PPN of high seg file. *** MJC
1) 11500 ; Also file length after LOOKUP *** MJC
1) 11550 ; Used as dump wd cmd list. *** MJC
1) 11600 0
1) 11650 INTDAT: 17 ; Data mode. *** MJC
1) 11700 SYSDEV ; Dev name (defd before OPEN) *** MJC
1) 11750 0 ; Buffer indicators (none) *** MJC
1) 11800 SGPPPN: XWD SYSPRG,SYSPN ; High seg file area *** MJC
1) 11850 PATCHL: BLOCK 20
1) 11900 >
1) 12050 DDT: SETOM ERINT ;$$SET CONTROL H WITHOUT GOING THRU REE
*** NEWUCI.MAC *** PAGE 1
2) CAME 0,STNIL ;$$UNBIND STACK IF REGS LOOK OK
2) JRST GETHGH ;GO GET HIGH SEGMENT
2) MOVE B,SC2
2) PUSHJ P,UBD ;$$UNBIND STACK
2) JRST STRT ;go to re-allocator
2) GETHGH: CALLI RESET
2) MOVSI A,1
2) CALLI A,CORE ;ELIMINATE ANY OLD HIGH SEGS.
2) HALT
2) MOVEI A,HGHDAT
2) CALLI A,GETSEG ;GET THE PROPER HIGH SEG
2) HALT
2) MOVEI A,DEBUGO ;SET THE REE ADDRESS
2) HRRM A,JOBREN
2) JRST STRT ;GO TO ALLOCATE STORAGE
2) HGHDAT: SYSDEV
2) SYSNAM
2) 0
2) 0
2) XWD SYSPRG,SYSPN
2) 0>
2) DDT: SETOM ERINT ;$$SET CONTROL H WITHOUT GOING THRU REE
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 1,1
******** ILISP.MAC **** PAGE 1
1) 12350 CAIN 0,CNTLH
*** NEWUCI.MAC *** PAGE 1
2) CAIN 0,CNTLR
2) ; RESTORES SYSTEM OBLIST
2) JRST [HRRI 0,OBTBL(S)
2) HRRM 0,VOBLIST(S)
2) JRST DEBUGO+2]
2) ; AND TRIES FOR ANOTHER CONTROL CHARACTER
2) CAIN 0,CNTLH
******** ILISP.MAC **** PAGE 1
1) 15050 HRROI 0,CNIL2(S) ;initialize nil
1) 15100 MOVEM 0,STNIL# ;$$SAVE FOR REG CHECK AT START TIME
1) 15150 IFN HASH,<
*** NEWUCI.MAC *** PAGE 1
2) IFN OLDNIL <HRROI 0,CNIL2(S)> ;INITIALIZE NIL
2) IFE OLDNIL <SETZ 0, >
2) MOVEM 0,STNIL# ;$$SAVE FOR REG CHECK AT START TIME
2) MOVEI A,CNIL2(S) ;## GET PROP LIST OF NIL
2) MOVEM A,NILPRP# ;## AND SAVE IT FOR GET ETC.
2) IFN HASH,<
******** ILISP.MAC **** PAGE 1
1) 16300 PAGE
1) 16350 INITFN: EXCH A,INITF#
*** NEWUCI.MAC *** PAGE 1
2) INITFL: EXCH A,INITF1# ;## NEW INIT FILE LIST
2) POPJ P, ;## RETURN THE OLD ONE
2) INITFN: EXCH A,INITF#
******** ILISP.MAC **** PAGE 1
1) 16950 ;BOOTSTRAPPER FOR USER'S INIT FILE
*** NEWUCI.MAC *** PAGE 1
2) COMMENT %
2) ;## OLD BOOTSTRAP CODE FOR INIT FILE, REPLACED BELOW
2) ;BOOTSTRAPPER FOR USER'S INIT FILE
******** ILISP.MAC **** PAGE 1
1) 17950 PAGE
1) 18000 SUBTTL APR INTERRUPT ROUTINES --- PAGE 3
1) 18050 ;arithmetic processor interupts
*** NEWUCI.MAC *** PAGE 1
2) %
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 1,1
2) ;## NEW IMPROVED BOOTSTRAPPER FOR USER'S INITFILE(S)
2) ;## ALLOWS MORE THAN ONE FILE. FIRST FILE IS READ IN
2) ;## OR IF NOT FOUND BEHAVES AS BEFORE (I.E. NO ERROR MESSAGE)
2) ;## REMAINING FILES WILL CAUSE AN ERROR MESSAGE IF NOT FOUND.
2) ;## THUS IF THE USER IS USING THIS TO REALLY SET UP HIS OWN
2) ;## SYSTEM, HE WILL KNOW ABOUT A FAILURE, BUT THE FIRST
2) ;## FILES EXISTENCE IS STILL OPTIONAL
2) BOOTS: SETOM BSFLG# ;## INDICATE BOOTSTRAP DONE
2) SKIPN T,INITF1# ;## GET INIT FILE LIST IF IT EXISTS
2) JRST BOOTOT ;## NOPE, EXCISE AND RETURN
2) MOVEI A,TRUTH(S) ;## USE CHANNEL T
2) PUSHJ P,INPUT2 ;## SET UP
2) PUSHJ P,ININIT ;## LOOK UP
2) JUMPN A,BOOTOK ;## IT'S THERE, GO TO IT
2) JUMPE T,BOOTOT ;## NOT THERE AND NO OTHERS REQUESTED
2) PUSHJ P,SETINA ;## SET UP FOR THE REST
2) PUSHJ P,ININIT ;## LOOK UP (SECOND FILE IN LIST)
2) JUMPE A,AIN.7 ;## NOT THERE, ERROR MESSAGE
2) BOOTOK: MOVEI A,TRUTH(S) ;##(INC T NIL)
2) SETZ B,
2) PUSHJ P,INC ;## SELECT
2) MOVEI A,READAT(S) ;## SET UP [(EVAL (READ))]
2) PUSHJ P,NCONS ;## (READ)
2) PUSHJ P,NCONS ;## ((READ))
2) MOVEI B,EVALAT(S)
2) PUSHJ P,XCONS ;##(EVAL(READ))
2) PUSHJ P,NCONS ;## [(EVAL(READ))]
2) PUSH P,A
2) MOVE A,(P)
2) PUSHJ P,ERRSET ;## AN EVAL-READ LOOP. PROTECTED AGAINST
2) CAIE A,$EOF$(S) ;## ALL ERRS EXCEPT $EOF$ AND ERRORX
2) JRST .-3 ;## LOOP
2) BOOTOT: PUSHJ P,EXCISE
2) JRST ERR
2) PAGE
2) SUBTTL APR INTERRUPT ROUTINES
2) ;arithmetic processor interupts
******** ILISP.MAC **** PAGE 1
1) 19450 SUBTTL UUO HANDLER AND SUBR CALL ROUTINES --- PAGE 4
1) 19550 UUOMIN==1
*** NEWUCI.MAC *** PAGE 1
2) PAGE
2) SUBTTL UUO HANDLER AND SUBR CALL ROUTINES
2) UUOMIN==1
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 1,1
******** ILISP.MAC **** PAGE 1
1) 21650 PAGE
1) 21700 SKIPA T,TT
*** NEWUCI.MAC *** PAGE 1
2) SKIPA T,TT
******** ILISP.MAC **** PAGE 1
1) 27700 MOVE TT,R
*** NEWUCI.MAC *** PAGE 1
2) MOVNS T
2) DPB T,[POINT 4,JOBUUO,ACFLD]
2) MOVE TT,R
******** ILISP.MAC **** PAGE 1
1) 29350 SUBTTL ERROR HANDLER AND BACKTRACE --- PAGE 5
1) 29400 ;subroutine to print sixbit error message
*** NEWUCI.MAC *** PAGE 1
2) PAGE
2) SUBTTL ERROR HANDLER AND BACKTRACE
2) ;subroutine to print sixbit error message
******** ILISP.MAC **** PAGE 1
1) 31450 HRROI NIL,CNIL2(S)
1) 31500 HRLZ B,INT1
*** NEWUCI.MAC *** PAGE 1
2) IFN OLDNIL< HRROI NIL,CNIL2(S)>
2) IFE OLDNIL< SETZ NIL, >
2) HRLZ B,INT1
******** ILISP.MAC **** PAGE 1
1) 31850 HLRZ C,@RHX5
*** NEWUCI.MAC *** PAGE 1
2) HRRZ C,VOBLIST(S) ;## GET CURRENT OBLIST
2) HRRM C,RHX5
2) HRRM C,RHX2 ;## AND UPDATE LOCATIONS WHICH REF OBLIST
2) HLRZ C,@RHX5
******** ILISP.MAC **** PAGE 1
1) 36200 ERREND: PUSHJ P,%CLRBFI ;CLEAR INPUT BUFFER
1) 36250 SKIPN UUO2 ;$$NO ERRORX IF OVERFLOW ERROR
*** NEWUCI.MAC *** PAGE 1
2) ERREND: SETZ A, ;## %CLRBFI USED TO BE HERE(FOR ERR NIL)
2) SKIPN UUO2 ;$$NO ERRORX IF OVERFLOW ERROR
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 1,1
******** ILISP.MAC **** PAGE 1
1) 36400 JRST RERX ;$$BOUNCE BACK TO ERRORX
1) 36450 SKIPN RSTSW ;$$NEW *RSET FEATURE
*** NEWUCI.MAC *** PAGE 1
2) JRST RERX ;$$BOUNCE BACK TO ERRORX
2) SKIPN RSTSW ;$$NEW *RSET FEATURE
******** ILISP.MAC **** PAGE 1
1) 36650 MOVEI A,ERRORX(S) ;$$ELSE SET TO CALL ERROR HANDLER
*** NEWUCI.MAC *** PAGE 1
2) PUSHJ P,%CLRBFI ;## CLEAR TTY BUFFER. ELIMINATE FLUSHING
2) ;## OF TYPE AHEAD
2) MOVEI A,ERRORX(S) ;$$ELSE SET TO CALL ERROR HANDLER
******** ILISP.MAC **** PAGE 1
1) 38700 JRST FALSE ;MIGHT BE EXTENDED LATER
1) 38750 PAGE
*** NEWUCI.MAC *** PAGE 1
2) SETZM CONSVA ;## RESET CONS COUNT
2) SETZM GCTIM ;## RESET GC TIME
2) JRST EXCISE ;## EXCISE
2) PAGE
******** ILISP.MAC **** PAGE 1
1) 00050 SUBTTL TYI AND TYO --- PAGE 6
1) 00100 ;input
1) 00150 ITYI: PUSHJ P,TYI
1) 00200 FIXI: ADDI A,INUM0
1) 00250 POPJ P,
1) 00350 TYI: MOVEI AR1,1
1) 00400 PUSHJ P,TYIA
*** NEWUCI.MAC *** PAGE 1
2) PAGE
2) SUBTTL TYI AND TYO
2) ;input
2) ITYI: PUSHJ P,TYI ;## RETURN ASCII VALUE OF INPUT CH
2) FIXI: ADDI A,INUM0
2) POPJ P,
2) TYI: MOVEI AR1,1 ;## TO TEST FOR LINED TYPESEQUENCE #, ETC
2) PUSHJ P,TYIA
******** ILISP.MAC **** PAGE 2
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
1) 00750 TYIA: SKIPE A,OLDCH
1) 00800 JRST TYI1
1) 00850 TYID: XCT TYI2
1) 00900 REMOTE<TYI2: JRST TTYI> ;sosg x for other device input
*** NEWUCI.MAC *** PAGE 1
2) TYIA: SKIPE A,OLDCH ;## IF CH IN OLDCH
2) JRST TYI1 ;## TAKE CARE OF IT
2) TYID: XCT TYI2 ;## INPUT A CHARACTER
2) REMOTE<TYI2: JRST TTYI> ;sosg x for other device input
******** ILISP.MAC **** PAGE 2
1) 01100 XCT TYI3A
1) 01150 REMOTE<TYI3A: TDNN AR1,@X> ;pointer
1) 01200 POPJ P,
1) 01250 IFN STPGAP,<
*** NEWUCI.MAC *** PAGE 1
2) XCT TYI3A ;## SEE IF LINED TYPE WORD
2) REMOTE<TYI3A: TDNN AR1,@X> ;pointer
2) POPJ P, ;## NO, OK
2) IFN STPGAP,<
******** ILISP.MAC **** PAGE 2
1) 02050 JRST TYI2Q ;END OF FILE>
1) 02100 TYI2Q: PUSH P,T
*** NEWUCI.MAC *** PAGE 1
2) TYIEOF: JRST TYI2Q ;END OF FILE>
2) TYI2Q: PUSH P,T
******** ILISP.MAC **** PAGE 2
1) 02550 POP P,AR1
*** NEWUCI.MAC *** PAGE 1
2) PUSHJ P,ININIT ;## INIT THE FILE
2) JUMPE A,AIN.7 ;## CAN'T FIND FILE, ERROR
2) POP P,AR1
******** ILISP.MAC **** PAGE 2
1) 02900 TALK ;turn off control o
1) 02950 MOVEI A,$EOF$(S) ;we are done
*** NEWUCI.MAC *** PAGE 1
2) TALK
2) MOVEI A,$EOF$(S) ;we are done
******** ILISP.MAC **** PAGE 2
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
1) 04800 TTYI: SKIPE DDTIFG
1) 04850 JRST TTYID
1) 04900 INCHSL A ;single char if line has been typed
1) 04950 JRST [TALK ;turn off control o, this
1) 05000 ;can be omitted when ttyser is fixed
1) 05050 OUTCHR PROMCH# ;$$OUTPUT PROMPT CHARACTER
1) 05100 INCHWL A ;wait for a line
1) 05150 JRST .+1]
1) 05200 TTYXIT: CAIE A,BELL
1) 05250 POPJ P,
*** NEWUCI.MAC *** PAGE 1
2) ERRCH: MOVEI A,-INUM0(A) ;## CHANGE BELL CHARACTER
2) EXCH A,ERRCHR ;## RETURN OLD CHARACTER
2) JRST FIX1A ;## CONVERT IT
2) REMOTE <
2) ERRCHR: BELL
2) >
2) TTYI: SKIPE DDTIFG ;## DDT MODE?
2) JRST TTYID
2) INCHSL A ;single char if line has been typed
2) JRST [OUTCHR PROMCH# ;$$OUTPUT PROMPT CHARACTER
2) INCHWL A ;wait for a line
2) JRST .+1]
2) TTYXIT: CAME A,ERRCHR ;## BELL, NEED NOT BE ↑G
2) POPJ P,
******** ILISP.MAC **** PAGE 2
1) 05650 TTYID: TALK ;turn off control o, remove this when ttyser works
1) 05700 INCHRW A ;single character input ddt submode style
1) 05750 CAIE A,RUBOUT
*** NEWUCI.MAC *** PAGE 1
2) TTYID: INCHRW A ;single character input ddt submode style
2) CAIE A,RUBOUT
******** ILISP.MAC **** PAGE 2
1) 10750 TTYCLR: SKPINC
1) 10800 CAI
1) 10850 POPJ P,
*** NEWUCI.MAC *** PAGE 1
2) TTYCLR: SKPINL ;## SKPINL FIXES RUBOUT PROBLEM IN TYPE AHEAD
2) JFCL
2) POPJ P,
******** ILISP.MAC **** PAGE 2
1) 11400 SUBTTL INPUT AND OUTPUT INITIALIZATION AND CONTROL --- PAGE 7
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
1) 11450 ;convert ascii to sixbit for device initialization routines
*** NEWUCI.MAC *** PAGE 1
2) SUBTTL INPUT AND OUTPUT INITIALIZATION AND CONTROL
2) ;convert ascii to sixbit for device initialization routines
******** ILISP.MAC **** PAGE 2
1) 13100 IOSUB: PUSHJ P,NXTIO
1) 13150 MOVEM T,DEVDAT#
1) 13200 LDB B,[POINT 6,A,35]
1) 13250 JUMPE A,IOPPN ;non-atomic item, must be ppn or (file.ext)
1) 13300 CAIE B,":"-40
1) 13350 JRST IOFIL ;not a device name -- must be file name
1) 13400 TRZ A,77 ;clear out the :
1) 13450 SETZM PPN
1) 13500 IODEV2: MOVEM A,DEV
1) 13550 PUSHJ P,INXTIO
*** NEWUCI.MAC *** PAGE 1
2) ;## SUBROUTINE TO TEST FOR A DEVICE OR QUEUE. USED BY I/O ROUTINES
2) ;## AND THE QUEUE ROUTINES. LEAVES A=0 IF NOT AN ATOM AND B=0
2) ;## DEVICE OR QUEUE.
2) DEVCHK: PUSHJ P,NXTIO ;## MAKE SIXBIT IF AN ATOM
2) LDB B,[POINT 6,A,35];## GET LAST CHAR
2) CAIN B,':' ;## DEVICE?
2) TRZA A,77 ;## YES, CLEAR CHAR BUT LEAVE B INTACT
2) SETZ B, ;## NO, CLEAR B
2) POPJ P, ;## DONE, IF A=0 OR B=0, NOT A DEVICE
2) ;## SUBROUTINE TO PARSE THE I/O SPECIFICATION. DEFAULT IS DSK IF
2) ;## NO DEVICE SPECIFIED.
2) IOSUB: MOVEM T,DEVDAT# ;## SAVE ARG FOR ERRORS
2) SKIPE DEV ;## DEVICE ALREADY SPECIFIED?
2) JRST .+4 ;## YES, FORGET DEFAULT
2) SETZM PPN ;## CLEAR PPN
2) MOVSI A,'DSK' ;## STORE DSK AS DEFAULT
2) MOVEM A,DEV
2) PUSHJ P,DEVCHK ;## SEE IF DEVICE SPECIFIED
2) JUMPE A,IOPPN ;## NON-ATOMIC ARG, MUST BE PPN OR (FILE.EXT)
2) JUMPE B,IOFIL ;## NOT A DEVICE, MUST BE FILE NAME
2) SETZM PPN
2) IODEV2: MOVEM A,DEV
2) PUSHJ P,INXTIO
******** ILISP.MAC **** PAGE 2
1) 13800 HLRZ A,(A) ;caar is project number
1) 13850 IFE STANSW,< HRRZI A,-INUM0(A) ;$$ASSUME PROJECT NUMBER IS AN INUM>
1) 13900 IFN STANSW,< PUSHJ P,SIXMAK
1) 13950 PUSHJ P,SIXRT>
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
1) 14000 HRLM A,PPN ;project number
1) 14050 HLRZ A,(T)
1) 14100 PUSHJ P,CADR ;cadar is programmer number
1) 14150 IFE STANSW,< HRRZI A,-INUM0(A) ;$$ASSUME PROGRAMMER NUMBER IS AN INUM>
1) 14200 IFN STANSW,< PUSHJ P,SIXMAK
1) 14250 PUSHJ P,SIXRT>
1) 14300 HRRM A,PPN ;programmer number
1) 14350 HRLZI A,(SIXBIT /DSK/) ;disk is assumed
1) 14400 JRST IODEV2
1) 14500 IOFIL: SKIPN DEV
1) 14550 JRST AIN.1 ;no device named
1) 14600 JUMPN A,IOFIL2 ;was it an atom
1) 14650 JUMPE T,CPOPJ ;no, was it nil (end)
*** NEWUCI.MAC *** PAGE 1
2) PUSHJ P,CNVPPN ;## CONVERT PPN
2) MOVEM A,PPN
2) HRLZI A,(SIXBIT /DSK/) ;disk is assumed
2) JRST IODEV2
2) IOFIL: JUMPN A,IOFIL2 ;was it an atom
2) JUMPE T,CPOPJ ;no, was it nil (end)
******** ILISP.MAC **** PAGE 2
1) 16500 REMOTE<
*** NEWUCI.MAC *** PAGE 1
2) ;## LEFT HALF OF A CHANNEL TABLE ENTRY IS THE REMAINING
2) ;## FILE LIST. RH POINTS TO EXTENDED HEADER.
2) REMOTE<
******** ILISP.MAC **** PAGE 2
1) 19800 INPUT: PUSHJ P,CHNSUB ;determine channel name
1) 19850 PUSH P,A
1) 19900 PUSHJ P,TABSRC ;get physical channel number
1) 19950 PUSHJ P,SETIN ;init device
1) 20000 JRST POPAJ
1) 20100 SETIN: MOVEM A,CHANNEL
*** NEWUCI.MAC *** PAGE 1
2) INPUT1: PUSHJ P,CHNSUB ;determine channel name
2) MOVEI AR1,(A) ;## SAVE CH NAME
2) EXCH AR1,(P) ;## EXHANGE WITH RETURN ADDR
2) PUSH P,AR1 ;## AND STUFF THE RETURN ADDR. IN
2) INPUT2: PUSHJ P,TABSRC ;## GET PHYSICAL CHANNEL NUMBER
2) MOVEM A,CHANNEL ;## SAVE IT
2) SETZM DEV ;## CLEAR DEV SO THAT WE CAN
2) ;## DEFAULT IF APPROPRIATE
2) JRST SETIN1 ;## SET UP FOR INITIALIZTION
2) INPUT: PUSHJ P,INPUT1
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) PUSHJ P,ININIT
2) INFAIL: JUMPE A,AIN.7 ;## CAN'T FIND FILE
2) JRST POPAJ
2) BINPUT: PUSHJ P,INPUT1 ;## IMAGE BINARY INPUT
2) PUSHJ P,BNINIT
2) JRST INFAIL
2) ISFILE: JUMPE A,.+5 ;## ROUTINE TO TELL USER IF A FILE EXISTS
2) PUSH P,A ;## SAVE A IF NON-NIL
2) MOVEI A,(B) ;## GET THE FILE NAME
2) PUSHJ P,NCONS ;## (FILNAM)
2) POP P,B ;## GET THE DEVICE BACK
2) PUSHJ P,XCONS ;## (DEV FILNAM) OR (FILNAM) WHEN HERE
2) PUSH P,A ;## SAVE IT FOR RETURN
2) PUSHJ P,RENSUB ;## SEE IF IT'S THERE
2) PUSH P,A ;## SAVE THE ANSWER
2) PUSHJ P,RENCLR ;## CLEAR THE CHANNEL
2) POP P,A ;## ANSWER IN A
2) JUMPN A,POPAJ ;## IF NON-NIL, THEN IT'S THERE
2) POP P,B ;## POP ANSWER OFF
2) POPJ P, ;## AND RETURN NIL
2) RENSUB: MOVEM A,DEVDAT ;## SAVE IT FOR ERROR MSGS
2) PUSHJ P,GENSYM ;## DON'T CLOBBER CURRENT CHANNELS
2) MOVE T,DEVDAT ;## GET IT BACK
2) PUSHJ P,INPUT2 ;## SET UP AND OPEN
2) JRST ININIT ;## AND INIT
2) RENAME: PUSHJ P,RENSUB ;## RENAME SETUP
2) JUMPE A,RENCLR ;## NIL IF CAN'T FIND FILE
2) PUSHJ P,SETINA ;## PROCESS THE NEW NAME
2) XCT RNAME ;## EXECUTE
2) JRST RENCLR ;## RETURN NIL IF FAILURE
2) PUSHJ P,RENCLR ;## CLEAR CHANNEL
2) JRST TRUE ;## AND RETURN T IF GOOD
2) REMOTE <
2) RNAME: RENAME X,LOOKIN ;## RENAME FILE
2) >
2) DELERR: PUSHJ P,AIOP
2) PUSHJ P,RENCLR ;## KILL THE CHANNEL
2) ERR1 [SIXBIT /CAN'T DELETE FILE !/]
2) DELETE: PUSHJ P,RENSUB ;## FIRST SETUP(ALLOWS DEFAULT TO DSK:)
2) JRST .+2 ;## ALREADY INIT'ED
2) DELET1: PUSHJ P,ININIT ;## INIT AND LOOKUP
2) JUMPE A,DELET2 ;## IF FILE NOT THERE IGNORE
2) SETZM LOOKIN ;## BLAST FILE NAME
2) SETZM EXT ;## AND EXTENSION
2) XCT RNAME ;## AND RENAME OUT OF EXISTENCE
2) JRST DELERR ;## RENAME FAILURE
2) DELET2: JUMPE T,RENCLR ;## DONE
2) MOVEM T,DEVDAT ;## SAVE REST OF LIST FOR MSGS.
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) PUSHJ P,SETINA ;## PROCESS NEXT FILE
2) JRST DELET1 ;## AND DO IT AGAIN
2) RENCLR: PUSH P,CHANNEL ;## CLEAR CHANNEL
2) SETO B, ;## FAKE (INC RENCHANNEL T)
2) PUSHJ P,IOSEL ;## RELEASE THE CHANNEL
2) JRST POPAJ ;## RETURN NIL (IOSEL CHANGED THINGS)
2) ;## TO LOOK UP A UFD FOR DIRECTORY FNS. SUBR
2) UFDINP: PUSH P,A
2) MOVEI T,(B)
2) PUSHJ P,TABSRC
2) MOVEM A,CHANNEL ;## HAVE A CHANNEL
2) MOVE A,[XWD 'DSK','UFD']
2) HRLZM A,EXT
2) HLLZM A,DEV
2) SETZ B,
2) AOBJP B,.+1 ;## UFD'S SHOULD BE ON [1,1]
2) MOVEM B,PPN
2) SKIPN A,T
2) PUSHJ P,MYPPN ;## IF B=NIL, DEFAULT TO USER'S PPN
2) MOVEM A,DEVDAT
2) PUSHJ P,CNVPPN ;## CONVERT PPN
2) SETZ T, ;## ZAP T (NO MORE FILES)
2) PUSHJ P,SETIN2 ;## SETUP
2) PUSHJ P,BNINIT ;## INIT AS BINARY
2) JUMPE A,ERR ;## ERR NIL IF NOT THERE
2) PUSHJ P,ININBF ;## SET UP BUFFERS
2) JRST POPAJ ;## RETURN CHANNEL
2) MYPPN: GETPPN A, ;## GET PPN
2) CAI ;## WIERD SKIP RETURN ON THIS UUO
2) HLRZ C,A ;## ASSUME PPN'S ARE INUMS
2) HRRZI A,INUM0(A) ;## CONVERT
2) PUSHJ P,NCONS
2) HRRZI B,INUM0(C)
2) JRST XCONS ;## (PROJ PRGRM)
2) CNVPPN: MOVS A,(A) ;## ASSUME PPNS INUMS
2) HRRI A,-INUM0(A) ;## LH=CDR, RH=CAR
2) MOVSS A ;## SWAP HALVES
2) HLR A,(A) ;## RH=CADR NOW
2) HRRI A,-INUM0(A)
2) POPJ P,
2) SETINA: MOVE A,CHANNEL ;## FOR ROUTINES THAT PROCESS MORE
2) HRRZ C,CHTAB(A) ;## AND KEEP THE CHANNEL IN CHANNEL
2) SETIN: MOVEM A,CHANNEL
******** ILISP.MAC **** PAGE 2
1) 20350 PUSHJ P,IOSUB ;get device and file name
1) 20400 MOVEM A,LOOKIN ;file name
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
1) 20450 MOVE A,DEV
1) 20500 CALLI A,DEVCHR
*** NEWUCI.MAC *** PAGE 1
2) SETIN1: PUSHJ P,IOSUB ;get device and file name
2) SETIN2: MOVEM A,LOOKIN ;file name
2) MOVE A,DEV
2) MOVEM A,BDEV ;## ALLOW IMAGE BINARY MODE
2) CALLI A,DEVCHR
******** ILISP.MAC **** PAGE 2
1) 20850 DPB A,[POINT 4,INLOOK,ACFLD]
*** NEWUCI.MAC *** PAGE 1
2) DPB A,[POINT 4,BNINIT,ACFLD] ;## FOR IMAGE BINARY
2) DPB A,[POINT 4,RNAME,ACFLD] ;## FOR RENAME
2) DPB A,[POINT 4,INLOOK,ACFLD]
******** ILISP.MAC **** PAGE 2
1) 21100 MOVEM A,DEV+1 ;pointer to bufdat
1) 21150 JRST ININIT
1) 21200 REMOTE<
1) 21250 ININIT: INIT X,
1) 21300 DEV: X
1) 21350 X
1) 21400 JRST AIN.7 ;cant init
1) 21450 PUSH B,DEV
1) 21500 PUSH B,PPN
1) 21550 INLOOK: LOOKUP X,LOOKIN
1) 21600 JRST AIN.7 ;cant find file
1) 21650 JRST IRET1>
*** NEWUCI.MAC *** PAGE 1
2) MOVEM A,DEV1 ;pointer to bufdat
2) MOVEM A,BDEV1 ;## IMAGE BINARY MODE
2) POPJ P, ;## SET UP FOR INITIALIZTION
2) REMOTE<
2) BNINIT: INIT X,13 ;## INIT DEVICE IN IMAGE BINARY
2) BDEV: X
2) BDEV1: X
2) JRST AIN.7 ;## CAN'T INIT
2) JRST INITOK
2) ININIT: INIT X,
2) DEV: X
2) DEV1: X
2) JRST AIN.7 ;cant init
2) INITOK: PUSH B,DEV
2) PUSH B,PPN
2) INLOOK: LOOKUP X,LOOKIN
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) JRST FALSE ;## LET SOMEONE ELSE HANDLE THE ERROR
2) JRST IRET1>
******** ILISP.MAC **** PAGE 2
1) 21900 >
1) 21950 ADDI B,4
1) 22000 HRRM B,JOBFF
1) 22050 JRST ININBF
1) 22100 REMOTE<
1) 22150 ININBF: INBUF X,NIOB
1) 22200 JRST TRUE
1) 22300 ENTR:
*** NEWUCI.MAC *** PAGE 1
2) >
2) ADDI B,4
2) HRRM B,JOBFF
2) JRST ININBF
2) REMOTE<
2) ININBF: INBUF X,NIOB
2) JRST TRUE ;## RETURN FROM GOOD LOOKUP WITH T
2) ENTR:
******** ILISP.MAC **** PAGE 2
1) 22800 PUSHJ P,IOSUB ;get device and file name
*** NEWUCI.MAC *** PAGE 1
2) SETZM DEV ;## CLEAR DEV FOR DEFAULT TO DSK:
2) PUSHJ P,IOSUB ;get device and file name
******** ILISP.MAC **** PAGE 2
1) 25150 DPB C,[POINT 4,RLS,ACFLD]
1) 25200 XCT RLS
*** NEWUCI.MAC *** PAGE 1
2) IOSEL1: DPB C,[POINT 4,RLS,ACFLD]
2) XCT RLS
******** ILISP.MAC **** PAGE 2
1) 00050 SUBTTL PRINT --- PAGE 8
1) 00150 EPRINT: SKIPN ERRSW
*** NEWUCI.MAC *** PAGE 1
2) PAGE
2) SUBTTL QMANGR INTERFACE
2) ;## CODE TO ALLOW LISP USER'S TO CALL DEC'S QMANGR, ALLOWING
2) ;## PRINTING OF FILES AND CREATION OF JOBS
2) ;## SCANS ARG LIST SETTING UP THE APPROPRIATE PARAMETERS. IT
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) ;## SAVE THE PDLS, SWAPS HI-SEGS FOR SYS:QMANGR AND
2) ;## DOES A PUSHJ TO 400010. IT ALSO CHANGES JOBREN SO
2) ;## THAT THE USER CAN RECOVER IN CASE OF QMANGR ERRORS.
2) ;## ST WILL ALSO STILL WORK. REG 17 (SP) IS USED AS QMANGR'S
2) ;## PDL. CORE IS CONTRACTED AFTER RETURN FROM QMANGR AND QUEUE
2) ;## RESTORES APPROPRIATE REGS AND RETURNS NIL. ALTHOUGH
2) ;## CODE FOR EXTENDED SWITCHES IS INCLUDED, MOST OF
2) ;## IT IS TURNED OFF. USE AT YOUR OWN RISK. NOTE THAT
2) ;## /LIST, /AFTER AND /DEAD REQUIRE SPECIAL CODE
2) ;## THAT IS NOT INCLUDED. SEE APPROPRIATE
2) ;## DEC DOCUMENTATION FOR FURTHER INFO. 6/12/73
2) IFN QALLOW <
2) IFNDEF QSWEXT <QSWEXT=0> ;## IF NOT DEFINED THEN DEFAULT IS NO EXTENDED
2) IFE QSWEXT <NSWS==QTABL1>;## NUMBER OF ALLOWED SWITCHES
2) IFN QSWEXT <NSWS==QTABL2>;## LENGTH OF EXTENDED TABLE
2) IFNDEF QLSTOK <QLSTOK==0>
2) IFNDEF QTIME <QTIME==0>
2) ;%% THE FOLLOWING CODE IS AN ILLUSTRATION OF HOW
2) ;%% EASY IT IS TO LOSE TRYING TO INTERFACE TO
2) ;%% DEC SOFTWARE. THE FOLLOWING DEFINITIONS ALLOW
2) ;%% TOO FEW WORDS FOR THE CURRENT FILE PARAMETER
2) ;%% AREA; SEE THE DEFINITIONS AS COPIED FROM
2) ;%% THE QMANGR SOURCE BELOW.
2) COMMENT &
2) INPPAR==32 ;## NUMBER OF WORDS IN INP AREA FOR INPUT REQUEST
2) OUTPAR==24 ;## NUMBER WORDS IN MAIN AREA FOR OUTPUT REQUEST
2) DIFPAR==INPPAR-OUTPAR ;## DIFFERENCE IN LENGTHS FOR MAIN AREA TYPES
2) FILPAR==14 ;## NUMBER WORDS IN FILE PARAMTER AREA
2) ;## LOCATIONS IN PARAMETER AREAS
2) ;## MAIN AREA
2) Q.MEM==0 ;## MEMORY FOR QMANGR
2) Q.OPR==1 ;## REQUESTED OPERATION
2) Q.LEN==2 ;## RH=NUMBER OF FILES IN REQUEST
2) Q.DEV==3 ;## REQUESTED QUEUE
2) Q.PPN==4 ;## PPN REQUESTING
2) Q.JOB==5 ;## JOB NAME
2) Q.SEQ==6 ;## JOB SEQUENCE #
2) Q.PRI==7 ;## EXTERNAL PRIORITY
2) Q.PDEV==10 ;##
2) Q.TIME==11 ;##
2) Q.CREA==12 ;##
2) Q.AFTR==13 ;## AFTER PARAMETER
2) Q.DEAD==14 ;## DEADLINE PARAMETER
2) Q.CNO==15
2) Q.USER==16 ;## AND 17
2) ;## INPUT SECTION OF MAIN PARAMETER AREA
2) Q.IDEP==20 ;## RESTART AND DEPENDENCY PARAMTERS
2) Q.ILIM==21 ;## CORE AND CPU, +1 IS LPT LIMIT AND CDP LIMIT
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) ;## +2 IS PTP LIMIT AND PLOT LIMIT
2) Q.IDDI==24 ;## THRU 31
2) Q.IEND==31 ;## LAST LOC OF INP AREA
2) ;## OUTPUT SEECTION OF MAIN PARAMETER AREA
2) Q.OFRM==20 ;## FORM PARAMTER
2) Q.OSIZ==21 ;## LH=LIMIT
2) Q.ONOT==22
2) Q.OEND==23 ;## LAST LOC OF OUTPUT AREA
2) ;## FILE PARAMETER AREA (ONE FOR EACH FILE)
2) Q.FSTR==0 ;## FILE STRUCTURE
2) Q.FDIR==1 ;## THRU 6, DIRECTORY
2) Q.FNAM==7 ;## FILE NAME
2) Q.FEXT==10 ;## FILE EXTENSION
2) Q.FRNM==11 ;## RENAME NAME (0)
2) Q.FBIT==12
2) Q.FMOD==13 ;## SPACING, FILE DISPOSAL, COPIES
2) & ;%% END OF DELETED DEFINITIONS
2) ;%% THE FOLLOWING ARE AS COPIED FROM QMANGR (VERSION 34)
2) ;%% ON 24 OCTOBER 1973
2) QDEFST==. ;%% WHERE TO RELOC TO AFTERWARDS
2) RELOC 0 ;%% TO SAVE CORE AND AVOID CONFUSION
2) ;%% COMMENTS BELOW ARE AS COPIED
2) ;%% FROM QMANGR
2) PHASE 0
2) Q.ZER:! ;START OF QUEUE PARAMETER AREA
2) Q.MEM:! BLOCK 1 ;HOLD XWD WINDOW BLOCK,WINDOW WORD INDEX
2) Q.OPR:! BLOCK 1 ;OPERATION CODE
2) QO.CRE==1 ;CREATION OPERATION
2) QO.LST==4 ;LIST OPERATION
2) QO.MOD==5 ;MODIFY OPERATION
2) QO.KIL==6 ;KILL OPERATION
2) QO.DEL==10 ;DELETE OPERATION
2) QO.REQ==11 ;REQUEUE OPERATION
2) QO.FLS==12 ;FAST LIST OPERATION
2) Q.LEN:! BLOCK 1 ;LENGTHS IN AREA
2) Q.DEV:! BLOCK 1 ;DESTINATION DEVICE
2) Q.PPN:! BLOCK 1 ;PPN ORIGINATING REQUEST
2) Q.JOB:! BLOCK 1 ;JOB NAME
2) Q.SEQ:! BLOCK 1 ;JOB SEQUENCE NUMBER
2) Q.PRI:! BLOCK 1 ;EXTERNAL PRIORITY
2) Q.PDEV:! BLOCK 1 ;PROCESSING DEVICE
2) Q.TIME:! BLOCK 1 ;PROCESSING TIME OF DAY
2) Q.CREA:! BLOCK 1 ;CREATION TIME
2) Q.AFTR:! BLOCK 1 ;AFTER PARAMETER
2) Q.DEAD:! BLOCK 1 ;DEADLINE TIMES
2) Q.CNO:! BLOCK 1 ;CHARGE NUMBER
2) Q.USER:! BLOCK 2 ;USER'S NAME
2) Q.I:! ;START OF INPUT QUEUE AREA
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) Q.IDEP:! BLOCK 1 ;DEPENDENCY WORD
2) Q.ILIM:! BLOCK 3 ;JOB LIMITS
2) Q.IL:! ;END OF AREA NEEDED TO READ FOR MASTER QUEUE
2) Q.IDDI:! BLOCK 6 ;JOB'S DIRECTORY
2) Q.II:! ;START OF INPUT FILES AREA
2) PHASE Q.I
2) Q.O:! ;START OF OUTPUT QUEUE AREA
2) Q.OFRM:! BLOCK 1 ;FORMS REQUEST
2) Q.OSIZ:! BLOCK 1 ;LIMIT WORD
2) Q.OL:! ;END OF AREA NEEDED TO READ FOR MASTER QUEUE
2) Q.ONOT:! BLOCK 2 ;ANNOTATION
2) Q.FF:!
2) PHASE 0
2) Q.F:! ;DUPLICATED AREA FOR EACH REQUESTED FILE
2) Q.FSTR:! BLOCK 1 ;FILE STRUCTURE
2) Q.FDIR:! BLOCK 6 ;ORIGINAL DIRECTORY
2) Q.FNAM:! BLOCK 1 ;ORIGINAL NAME
2) Q.FEXT:! BLOCK 1 ;ORIGINAL EXTENSION
2) Q.FRNM:! BLOCK 1 ;RENAMED FILE NAME (0 IF NOT)
2) Q.FBIT:! BLOCK 1 ;BIT 0=PRESERVED BY QUEUE, REST=STARTING BIT
2) Q.FMOD:! BLOCK 1 ;FILE SWITCHES
2) X.LOG==1B1 ;FILE IS LOG FILE
2) X.NEW==1B2 ;OK IF FILE DOESNT EXIST YET
2) Q.FRPT:!BLOCK 2 ;/REPORT
2) Q.FLEN==.-Q.F
2) DEPHASE
2) PHASE 0
2) Q.FDRM:! BLOCK 6 ;DIRECTORY MASK FOR MODIFY
2) Q.FNMM:! BLOCK 1 ;FILE NAME MASK FOR MODIFY
2) Q.FEXM:! BLOCK 1 ;EXTENSION MASK FOR MODIFY
2) Q.FMDM:! BLOCK 1 ;MODIFIER MASK FOR MODIFY
2) Q.FMLN==.-Q.F ;LENGTH OF MODIFY BLOCK
2) DEPHASE
2) RELOC QDEFST ;%% MAKE UP FOR INCREASE IN LOCATION
2) ;%% COUNTER
2) INPPAR==Q.II ;%% SIZE OF MINIMUM INPUT AREA
2) OUTPAR==Q.FF ;%% SIZE OF MINIMUM OUTPUT AREA
2) OUTPR1==OUTPAR-1 ;%% MACRO DOESN'T LIKE EXPRESSIONS
2) DIFPAR==INPPAR-OUTPAR ;%% DIFFERENCE IN AREAS
2) FILPAR==Q.FLEN ;%% FILE DATA AREA
2) LOWLEN==↑D110 ;## AREA NEED FOR PARAMETER
2) ;## AREA TO QMANGR
2) LHLEN==OUTPR1*1B26+FILPAR ;## LH OF Q.LEN DEFAULTS
2) NQS==6 ;## NUMBER OF QUEUES
2) ;## QUEUE ERRORS
2) QILLSW: HLRZ A,(T) ;## GET SWITCH THAT CAUSED ERROR
2) PUSHJ P,PRINT
2) STRTIP [SIXBIT / =ILL. SWITCH SPEC.!/]
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) PUSHJ P,CONCOR ;## SAVE THAT CORE
2) QERR1: ERR1 [SIXBIT /ERROR IN QUEUE REQUEST!/]
2) QUEUE: SKIPN T,A ;## ERROR IF NO ARGS
2) JRST QERR1
2) PUSHJ P,DEVCHK ;## SEE IF QUEUE SPECIFIED
2) JUMPE A,NOQUE ;## IF A=0 THEN NOT A QUEUE
2) JUMPE B,NOQUE ;## IF B=0 THEN NOT A QUEUE
2) MOVE AR2A,A
2) HLRZ B,A ;## GET FIRST THREEE LETTERS
2) MOVEI C,NQS ;## GET NUMBER OF PERMISSIBLE QUEUES
2) SOJL C,NOQUE ;## IF EXHAUSTED TABLE, THEN NO QUEUE
2) MOVE A,QSTABL(C) ;## PERMISSIBLE QUEUES
2) JSP R,CHKGO ;## JUMP TO ROUTINE THAT COMPARES RH AND GO
2) ;## TO LH OF A IFF RH(A)=B
2) JRST .-3 ;## LOOP
2) ;## TABLE OF PERMISSIBLE QUEUES AND WHERE TO GO ON EACH
2) QSTABL: XWD INPREQ, 'INP'
2) XWD OUTREQ, 'LPT'
2) XWD OUTREQ, 'PTP'
2) XWD OUTREQ, 'PTP'
2) XWD OUTREQ, 'CDP'
2) XWD OUTREQ, 'PLT'
2) OUTREQ: TDZA A,A ;## HERE TO PROCESS OUTPUT REQUEST(CLEAR A)
2) INPREQ: MOVEI A,DIFPAR ;## HERE TO PROCESS INPUT REQUEST
2) JRST QGOOD ;## FOUND A QUEUE
2) NOQUE: MOVSI AR2A,'LPT' ;## HERE IF NO QUEUE, DEFAULT=LPT
2) TDZA A,A ;## CLEAR A AND SKIP
2) QGOOD: HRRZ T,(T) ;## HERE IF QUEUE SPECIFIED
2) ADDI A,OUTPAR ;## A IS ZERO OR INPPAR
2) QSETUP: PUSH P,B ;## B CONTAINS THREE LETTERS(OR BLANK). SAVE IT
2) HRLZI TT,(A) ;## SAVE LNENGTH OF AREA
2) PUSHJ P,TEMCOR ;## EXPAND CORE
2) HRRI TT,(A) ;## START ADDR OF MAIN AREA
2) MOVE A,TT
2) PUSHJ P,CLRBLK ;## CLEAR AREA
2) MOVEM AR2A,Q.DEV(TT)
2) MOVEI C,LHLEN ;## GET LENGTHS FOR HEADER AND FILE AREAS
2) MOVE A,[XWD 500,500]
2) HRLZM A,Q.OSIZ(TT) ;## ASSUME OUTPUT HERE
2) POP P,B ;## RESTORE LEFT THREE LETTERS
2) CAIE B,'INP' ;## WAS IT AN INPUT REQUEST?
2) JRST QUEUE1 ;## NO SHOULD BE OK
2) ADDI C,DIFPAR←9 ;## UPDATE HEADER LENGTH
2) MOVEM A,Q.ILIM+1(TT) ;## MAX PAGES AND CARD PUNCH
2) MOVEM A,Q.ILIM+2(TT) ;## MAX PAPER TAPE AND PLOTTER
2) HRLI A,↑D256
2) MOVEM A,Q.ILIM(TT) ;## MAX CORE AND CPU(CORMAX MAY HAVE TO BE
2) ;## CHECKED HERE)
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) MOVSI A,400000 ;## SET BIT 0 FOR NOT RESTARTABLE
2) HLLZM A,Q.IDEP(TT) ;## NOT RESTARTABLE(NO DEPEND OR UNIQUENESS)
2) QUEUE1: MOVSM C,Q.LEN(TT) ;## SET HEADER AND FILE AREA LENGTHS
2) GETPPN A, ;## SET REQUESTING PPN
2) CAI ;## WEIRD SKIP RETURN ON THIS UUO
2) MOVEM A,Q.PPN(TT)
2) SETZ REL, ;## CLEAR REG FOR FILE AREA
2) MOVEI A,20 ;## PRIORITY DEFAULT
2) MOVEM A,Q.PRI(TT)
2) AOSA Q.OPR(TT) ;## SET DEFAULT FOR REQUEST TYPE=/CREATE
2) ;## BASIC LOOP FOR HANDLING THE SWITCHES
2) QLOOP: HRRZ T,(T) ;## HERE IF ROUTINE DID NOT MOVE ARG
2) QSELF: JUMPE T,QDONE
2) PUSHJ P,DEVCHK ;## SEE IF DEVICE OR ATOMIC FILE NAME?
2) JUMPN B,QFILEA ;## IF B#0 THEN DEVICE
2) JUMPN A,QFILE ;## IF A#0 THEN ATOMIC FILE
2) HLRZ C,(T) ;## WELL, SEE IF SWITCH
2) HRRZ A,(C) ;## CDAR
2) PUSHJ P,ATOM ;## ATOM?
2) JUMPN A,QFILE ;## YES, THEREFORE(FILE.EXT)
2) HLRZ B,(C) ;## CAAR
2) SUBI B,(S) ;## STRIP OFF RELOCATION
2) HRRZI C,NSWS ;## GET NUMBER OF SWITCHES
2) QLOOP1: SOJL C,QFILE ;## IF NO SWITCH, GO QFILE
2) MOVE A,QTABLE(C) ;## GET MEMBER OF TABLE
2) JSP R,CHKGO
2) JRST .-3 ;## LOOP
2) ;## DISPATCH TABLE FOR SWITCHES
2) QTABLE:
2) PHASE 1
2) XWD QCOPIE,COPIES ;## /COPIES
2) XWD QCPU,CPU ;## /CPU
2) XWD QFORMS,FORMS ;## /FORMS
2) XWD QLIMIT,LIMIT ;## /LIMIT
2) QTABL1: XWD QDISP,DISP ;## /DISP (FILE DISPOSITION)
2) ;## EXTENDED SWITCHES
2) IFN QSWEXT <
2) IFE QLSTOK <XWD QILLSW, LISTAT>
2) IFN QLSTOK <XWD QLIST, LISTAT>
2) IFE QTIME <
2) XWD QILLSW,AFTER ;## /AFTER ILLEGAL (SEE ABOVE)
2) XWD QILLSW,DEAD ;## /DEAD (DEADLINE)
2) >
2) IFN QTIME <
2) XWD QAFTR,AFTER
2) XWD QDEAD,DEAD
2) >
2) XWD QCORE,COREAT
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) XWD QMOD,MODIFY ;## /MODIFY
2) XWD QKILL,KILL ;## /KILL
2) XWD QJOB,JOB ;## /JOB
2) XWD QDEPND,DEPEND ;## /DEPEND
2) XWD QRSTR,RSTRT ;## /RESTART
2) XWD QUNIQ,UNIQUE ;## /UNIQUE
2) XWD QCORE,COREAT ;## /COREE
2) XWD QPAGES,PAGES ;## /PAGES
2) XWD QPLOT,PLOT ;## /PLOT
2) XWD QPTAPE,PTAPE ;## /PTAPE
2) XWD QCARDS,CARDS ;## /CARDS
2) XWD QSEQ,SEQ ;## /SEQ
2) XWD QPRIOR,PRIOR ;## /PRIOR (PRIORITY)
2) XWD QSPACE,SPACE ;## /SPACE (SPACING)
2) XWD QLIMIT,LIMIT ;## /LIMIT
2) QTABL2: XWD QHEAD,HEAD ;## /HEAD (HEADERS)
2) >
2) DEPHASE
2) ;## DISPATCHING THE VARIOUS SWITCHES
2) IFN QSWEXT <QLIST: HRRZI A,4 ;## HERE FOR LIST REQUEST
2) CAIA
2) QMOD: HRRZI A, 5 ;## /MODIFY
2) CAIA
2) QKILL: HRRZI A, 6 ;## /KILL
2) HRRZM A, Q.OPR(TT)
2) JRST QLOOP
2) >
2) ;## INPUT QUEUE ONLY SWITCHES
2) ;## PUTS BYTE POINTER INTO B AND THEN CHECKS TO SEE IF SWITCH VALID IN
2) ;## THIS CONTEXT (I.E. ARE WE PROCESSING AN INPUT REQUEST?)
2) ;## IF NOT VALID, SKIPS THE SWITCH(MAY BE CHANGED LATER)
2) IFN QSWEXT <
2) QPLOT: JSP R,RINPCH
2) AOJA B, QCARD+1
2) QPTAPE: JSP R, LINPCH
2) AOJA B, .+4
2) QCARDS: JSP R, RINPCH
2) AOJA B, .+4
2) QPAGES: JSP R, LINPCH
2) AOJA B, .+4
2) >
2) QCPU: JSP R, RINPCH
2) AOJA B,QARG
2) IFN QSWEXT <
2) QCORE: JSP R, LINPCH
2) AOJA B,QARG
2) QDEPND: JSP R, RINPCH
2) JRST QARG
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) >
2) ;## OUTPUT QUEUE ONLY SWITCHES
2) QFORMS: JSP R, OUTCHK
2) PUSH P,QSXARG ;## CONVERT ARG TO SIXBIT
2) MOVEM A, Q.OFRM(TT) ;## MAKE SIXBIT IF FORMS
2) JRST QLOOP
2) QLIMIT: JSP R, OUTCHK
2) MOVE B,LINP
2) AOJA B,QARG
2) OUTCHK: HLRZ A,Q.DEV(TT) ;## GET REQUEST TYPE (THREE LETTERS)
2) CAIE A,'INP' ;## ERROR IF INPUT REQUEST
2) JRST (R)
2) JRST QILLSW
2) QCOPIE: JSP R, FILECH ;## CHECK IF WE HAVE SET UP A FILE AREA
2) MOVE B,[POINT 6,Q.FMOD(REL),35] ;## BYTE POINTER
2) JRST QARG
2) ;## FOR DISPOSITION, 1=PRESERVE, 2=RENAME, 3=DELETE,
2) ;## FIRST THREE LETTERS OF ARG TO SWITCH UNIQUELY IDENTIFY
2) ;## ILLEGAL ARG CAUSES ERROR
2) QDISP: JSP R,FILECH ;## BE SURE FILE AREA SET UP
2) PUSHJ P,QSXARG ;## MAKE ARG SIXBIT
2) HLRZ C,A ;## GET FIRST THREE LETTERS
2) SETZ A, ;## CLEAR A
2) CAIN C,'DEL' ;## DELETE AFTER OUTPUT!
2) AOJA A,.+2 ;## YES!
2) CAIN C,'REN' ;## RENAME FILE OUT OF UFD?
2) AOJA A,.+3
2) CAIE C,'PRE' ;## PRESERVE IT
2) JRST QILLSW ;## HERE IF BAD ARGUMENT
2) ADDI A,1
2) MOVE B, [POINT 3, Q.FMOD(REL), 29]
2) JRST QARG+1 ;## ARG ALREADY IN A
2) ;## HERE WHEN SWITCH DETERMINED AND BITE POINTER IN B
2) QGTARG: MOVEI A,(T)
2) PUSHJ P,CADAR
2) SUBI A,INUM0 ;## ARG SHOULD BE AN INUM
2) POPJ P,
2) QARG: PUSHJ P,QGTARG ;## GET ARGUMENT
2) DPB A,B ;##
2) JRST QLOOP ;## ALWAYS RETURN TO QLOOP
2) ;## HERE TO SEE IF INP QUEUE FOR EXTENDED PART OF MAIN AREA
2) LINPCH: MOVE B,LINP ;## GET LH BITE POINTER
2) CAIA
2) RINPCH: MOVE B,RINP ;## GET RH BITE POINTER
2) HLRZ A,Q.DEV(TT) ;## GET QUEUE SPEC
2) CAIN A,'INP' ;## INP?
2) JRST (R) ;## YES
2) JRST QILLSW
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) LINP: POINT 18, Q.IDEP(TT),17 ;## BYTE POINTER FOR LEFT HALF OF EXTENDED MAIN AREA
2) RINP: POINT 18, Q.IDEP(TT),35 ;## BYTE POINT FOR RH OF EXTENDED MAIN AREA
2) ;## HERE TO BE SURE FILE AREA HAS BEEN SET UP
2) FILECH: JUMPN REL,(R) ;## REL NONZERO IF FILE AREA SET UP
2) PUSH P,R
2) JRST FILARE
2) ;## HERE TO FIND FILE SPECIFICATION
2) QFILEA: HRRZ T,(T) ;## GET CDR
2) SETZ B, ;## CLEAR B
2) JRST QFILEB
2) QFILE: MOVSI A,'DSK' ;## DEFAULT IS DSK
2) CAIE REL,0 ;## AREA SET UP?
2) SKIPA A,Q.FSTR(REL) ;## GET CURRENT DEVICE
2) SKIPA B,Q.PPN(TT) ;## GET USER'S PPN IF NOT SET UP
2) MOVE B,Q.FDIR(REL) ;## GET CURRENT PPN
2) QFILEB: MOVEM B,PPN ;## SET PPN
2) MOVEM A,DEV ;## HANG ON TO DEVICE
2) JUMPE T,QSELF ;## IF NIL THEN DONE
2) PUSHJ P,NXTIO ;## FAKE IOSUB SEQUENCE
2) PUSHJ P,IOPPN
2) PUSH P,A ;## IOPPN RETURNS FILE NAME IN A
2) CAIE REL,0 ;## AREA SET UP?
2) SKIPE Q.FNAM(REL) ;## AREA SET UP, BUT NO FILE NAME?(PRECEDING SWITCHES)
2) PUSHJ P,FILARE ;## SET UP AREA
2) MOVE A,DEV ;## GET DEVICEE
2) MOVEM A,Q.FSTR(REL) ;## SET FILE STRUCTURE
2) MOVE A,EXT ;## GET EXTENSION
2) MOVEM A,Q.FEXT(REL) ;## SET IT
2) MOVE A,PPN ;## GET PPN
2) MOVEM A,Q.FDIR(REL)
2) ;## SET IT(DIRECTORY)
2) POP P,Q.FNAM(REL) ;## RESTORE NAME
2) JRST QSELF ;## T HAS BEEN RESET BY IO ROUTINES!
2) ;## HERE TO SET UP FILE AREA
2) FILARE: AOS Q.LEN(TT) ;## ADD ONE TO NUMBER FILES IN REQUEST
2) HRLZI A,FILPAR
2) ADD TT,A ;## ADD TO LENGTH OF PARAMETER AREA
2) HRRZI A,FILPAR
2) PUSHJ P,EXPCOR
2) JUMPE REL,FILDEF ;## SET DEFAULST IF NO PREVIOUS FILE AREA
2) HRL A,REL
2) HRRZI B,(A) ;## SET UP FOR BLT OF PREVIOUS AREA
2) ADDI B,FILPAR-1 ;## FINAL DESTINATION ADDRESS
2) HRRZI REL,(A) ;## NEW FILE AREA
2) BLT A,(B)
2) SETZM Q.FNAM(REL)
2) POPJ P,
2) FILDEF: HRRZI REL,(A)
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) HRLI A,FILPAR
2) PUSHJ P,CLRBLK
2) HRLZI A,'DSK'
2) MOVEM A,Q.FSTR(REL)
2) MOVE A,[EXP 1B5+1B20+1B26+1B29+1] ;## DEFAULTS FOR Q.FMOD
2) MOVEM A,Q.FMOD(REL)
2) POPJ P,
2) ;## HERE WHEN FINISHED
2) QDONE: MOVE AR1,OUTPAR+Q.FNAM(TT) ;## GET FIRST FILE NAME
2) HLRZ A,Q.DEV(TT) ;## GET FIRST THREE LETTERS OF Q AGAIN
2) CAIE A,'INP' ;## INPUT QUEUE?
2) JRST QDONEB ;## NO
2) MOVE AR1,INPPAR+Q.FNAM(TT) ;## GET CORRCT FILE NAME
2) HRRZ A,Q.LEN(TT) ;## GET NUMBER OF FILES SPECIFIED
2) SOJG A,QDONEC ;## GREATER THAN ONE MEANS THAT USER
2) ;## SPECIFIED A LOG FILE
2) PUSHJ P,FILARE ;## WE HAVE TO SET UP LOG FILE
2) HRRZI A,'LOG' ;## CHANGE EXTENSION TO .LOG
2) HRLZM A,Q.FEXT(REL)
2) MOVEM AR1,Q.FNAM(REL) ;## SET TO INP FILE NAME
2) QDONEC: HRRI A,3
2) DPB A,[POINT 2,INPPAR+FILPAR+Q.FMOD(TT),2];## SET BITS
2) ;## INDICATING LOG FILE AND DOESN'T EXIST
2) ;## (AVOIDS ERROR MSGS FROM QMANGR)
2) ;## IN SECOND FILE IN CASE USER STUPIDLY SET
2) ;## UP MORE THAN TWO
2) QDONEB: SKIPE Q.JOB(TT) ;## SPECIFIED NAME
2) JRST QDONE1 ;## YES, DONE
2) MOVEM AR1,Q.JOB(TT)
2) QDONE1: MOVE C,[EXP 'QMANGR'];## SEGMENT NAME
2) MOVEI B,400010
2) MOVE A,TT
2) PUSHJ P,NEWHI
2) PUSHJ P,CONCOR ;## CONTRACT CORE
2) JRST FALSE ;## RETURN NIL
2) ;## ROUTINE TO SWAP HI-SEGMENTS. REGISTER A CONTAINS ARG TO NEXT HI-SEG, B CONTAINS
2) ;## LOCATION TO JUMP TO IN NEW HI-SEG. REGS ARE ARG BLOCK TO GETSEG UUO
2) ;## TO THE GET SEG
2) NEWHI: PUSH P,SP ;## HAVE TO SAVE SP, SINCE MOST
2) ;## SYSTEM PROGS USE 17 FOR THEIR PDL
2) MOVEM A,HIARGS# ;## SAVE ARG TO HI-SEG
2) HRRZM B,HIADDR# ;## SAVE ADDR TO HI-SEG
2) PUSH P,JOBFF ;%% SAVE OLD VALUE
2) ;%% (DON'T ASK WHY)
2) HLRZ B,A ;%% CALCULATE NEW VALUE
2) ADDI B,1(A) ;%%
2) MOVEM B,JOBFF ;%% RESET SO QMANGR WON'T WRITE
2) ;%% OVER ARGUMENT BLOCK.
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) ;%% JUST BECAUSE LISP IGNORES JOBFF
2) ;%% DOESN'T MEAN ANYONE ELSE DOES
2) MOVEM P,PSAVE# ;## SAVE P (CAN'T USE SP)
2) MOVE SP,P ;## USE RPDL
2) HRRZI A,OLDHI ;## REE WILL RESTORE AND CONTINUE
2) MOVEM A,JOBREN
2) MOVEM A,JOBREN ;## SET FAKE REE ADDRESS
2) HRLZI B,'SYS' ;## SYS: IS LOCATION OF NEW HI-SEG
2) MOVEI A,B ;## B IS STARTING LOCATION OF BLOCK TO GETSEG
2) SETZB AR1,AR2A ;## CLEAR REST OF BLOCK
2) SETZB T,TT ;## DITTO
2) MOVEM SP,SAVSP# ;## SAVE SP AROUND GETSEG (WHICH CLOBBERS ACS)
2) JRST NEWHI1 ;## GO DO IT
2) ;## HERE TO GET THAT HI-SEG
2) REMOTE <
2) NEWHI1: CALLI A,GETSEG
2) JRST @JOBREN ;## FAILED JOBREN HAS LOC OF RESTORE LISP HI-SEG
2) MOVE SP,SAVSP
2) MOVE A,HIARGS
2) PUSHJ SP,@HIADDR ;## JUMP TO HI-SEG
2) OLDHI: MOVEI A,HGHDAT
2) CALLI A,GETSEG
2) HALT ;## YOU'RE DEAD IF YOU ARE HERE
2) ENDHI: JRST RESTOR ;## JUMP TO RESTORE THINGS
2) >
2) RESTOR: MOVE P,PSAVE
2) POP P,JOBFF ;%% RESTORE OLD VALUE
2) POP P,SP
2) MOVE 0,STNIL
2) MOVE S,ATMOV
2) HRRZI A,DEBUGO
2) MOVEM A,JOBREN
2) POPJ P,
2) TEMCOR: HRRZ B,CORUSE ;## GET CURRENT CORUSE. THIS ROUTINE EXPANDS CORE
2) ;## BUT SAVE INFO SO THAT IT CAN BE CONTRACTED LATER
2) HRL B,JOBREL ;## GET CURRENT CORE EXTENT
2) MOVEM B,OLDCU ;## SAVE IT (SEE LOADER INTERFACE)
2) EXPCOR: SETZ D, ;## D IS A RELOC REG
2) JRST MORCOR ;## EXPAND CORE
2) CONCOR: MOVS B,OLDCU ;## CONTRACTS CORE, OPPOSITE TEMCOR
2) HLRZM B,CORUSE
2) HRRZI B,(B) ;## CLEAR LH
2) PUSHJ P,MOVDWN ;## MOVE SYMBOL TABLE
2) CALLI B,CORE ;## CONTRACT (B SHOULD BE UNCHANGED
2) CAI
2) POPJ P, ;## DONE
2) QSXARG: MOVEI A,(T)
2) PUSHJ P,CADAR ;## GET ARGUMENT TO SWITCH
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 2,1
2) JRST SIXMAK ;## CONVERT IT TO SIXBIT
2) CLRBLK: SETZM (A) ;## CLEAR FIRST WORD
2) HLRZ B,A ;## LH OF A CONTAINS LENGTH
2) ADD B,A
2) HRL A,A
2) AOJ A, ;## RH NOW CONTAINS SOURCE+1
2) BLT A,-1(B) ;## BLT CLEARS BLOCK
2) POPJ P,
2) ;## PICKUP
2) CHKGO: CAIN B,(A) ;## SEE IF RH(A)=(B)
2) HLRZ R,A ;## WHERE TO GO
2) JRST (R) ;## NO, RETURN
2) >
2) PAGE
2) SUBTTL PRINT
2) EPRINT: SKIPN ERRSW
******** ILISP.MAC **** PAGE 4
1) 00050 SUBTTL SUPER FAST TABLE DRIVEN READ 14-MAY-69 PAGE 9
1) 00150 ;magic scanner table bit definitions
*** NEWUCI.MAC *** PAGE 2
2) PAGE
2) SUBTTL SUPER FAST TABLE DRIVEN READ 14-MAY-69
2) ;magic scanner table bit definitions
******** ILISP.MAC **** PAGE 4
1) 03800 LET (< >)
1) 03850 ;33 to 37
1) 03900 IGNORE (< >)
*** NEWUCI.MAC *** PAGE 2
2) DELIMIT (< >,3)
2) ;## NEW ALTMODE (5S06 MONITOR)
2) LET (< >)
2) ;## 34 TO 37
2) IGNORE (< >)
******** ILISP.MAC **** PAGE 4
1) 06050 ;altmode
1) 06100 LET (< >)
*** NEWUCI.MAC *** PAGE 2
2) ;## OLD ALTMODE (5S04 MONITOR)
2) LET (< >)
******** ILISP.MAC **** PAGE 4
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 4,2
1) 07200 RDRUB: MOVEI A,CR
*** NEWUCI.MAC *** PAGE 2
2) RDNAM: SETOM NOINFG ;## READ ROUTINE THAT DOES NOT INTERN
2) JRST READ+1 ;##
2) RDRUB: MOVEI A,CR
******** ILISP.MAC **** PAGE 4
1) 17000 ;NEW AND SUBER BITCHEN READ MACROS
1) 17050 ;
*** NEWUCI.MAC *** PAGE 2
2) ;## FUNCTIONS TO READ A FILE.EXT
2) ;## READ A FILE.EXT FROM THE UFD
2) FLTYIA: XCT TYI2 ;## GET NEXT WORD, IGNORE OLDCH
2) JRST TYI2X ;## INPUT SOME MORE
2) ILDB A,@TYI3 ;## AND LOAD WORD
2) POPJ P,
2) RDFIL1: PUSHJ P,FLTYIA ;## FILE NAME NOT THERE, SKIP OVER EXT
2) RDFILE: SETZM NOINFG ;## ## INTERN
2) PUSHJ P,FLTYIA ;## GET FILE NAME WORD
2) PUSHJ P,SIXATM ;## MAKE IT AN ATOM
2) JUMPL A,RDFIL1 ;## A=-1 IF EMPTY
2) PUSH P,A
2) PUSHJ P,FLTYIA ;## GET EXTENSION
2) HRRI A,0 ;## CLEAR RH
2) PUSHJ P,SIXATM
2) JUMPL A,POPAJ ;## NO EXTENSION, RETURN
2) POP P,B ;## GET FILE BACK
2) JRST XCONS ;## RETURN FILE.EXT
2) ;## ROUTINE TO TAKE ONE WORD OF SIXBIT AND MAKE IT AN ATOM
2) ;## IGNORES TRAILING BLANKS, BUT INCLUDES INSERTED BLANKS. NO
2) ;## READ MACROS, ETC.
2) SIXATM: SKIPN B,A
2) JRST SXATER ;## INDICATE WORD EMPTY
2) MOVEI T,5 ;## OF CHS PERMISSIBLE IN FULL WORD
2) ;## NAME T=0 IF FIRST WORD DONE
2) MOVE AR1,[POINT 6,B,5] ;## AR1 HAS PTR TO LOAD BYTE
2) ;## FROM B TO C
2) PUSHJ P,SIXAT1 ;## MAKE THE PNAME LIST
2) PUSHJ P,NCONS
2) MOVEI B,PNAME(S) ;## MAKE PNAME
2) PUSHJ P,XCONS
2) PUSHJ P,ACONS ;## VOILA, AN ATOM
2) SKIPE NOINFG ;## NOINFG=0 MEANS INTERN
2) POPJ P,
2) JRST INTERN
2) SXATER: SETO A, ;## RETURN -1 IN A IF B EMPTY
2) POPJ P,
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 4,2
2) SIXAT1: MOVE AR2A,[POINT 7,0,35] ;## POINTER TO MOVE C TO A
2) SETZ A, ;## CLEAR A
2) SIXAT2: SETZ C,
2) JUMPE B,SIXDON ;## DONE IF B EMPTY
2) LDB C,AR1
2) LSH B,6 ;## LEFT SHIFT B, REMAINING CH'S IN B
2) HRRI C,40(C) ;## ADD 40 TO C
2) IDPB C,AR2A ;## PUT IT IN A
2) SOJG T,SIXAT2 ;## IF T>0, STILL IN FIRST WORD OF PNAME
2) SIXAT3: PUSHJ P,FWCONS
2) PUSH P,A
2) JRST SIXAT1 ;## TRY FOR THAT SIXTH CH.
2) SIXDON: JUMPN A,SIXAT3 ;## IF A NOT EMTPY, DO ANOTHER FWCONS AND
2) ;## END UP HERE WITH A=0.
2) POP P,A
2) PUSHJ P,NCONS
2) JUMPGE T,CPOPJ ;## IF T>=0, THEN ONLY ONE WORD
2) POP P,B
2) JRST XCONS ;## DONE
2) ;NEW AND SUPER BITCHEN READ MACROS
2) ;
******** ILISP.MAC **** PAGE 4
1) 23850 HLRZ TT,@RHX2 ;get bucket
*** NEWUCI.MAC *** PAGE 2
2) PUSH P,C ;## SAVE C
2) HRRZ C,VOBLIST(S) ;## THIS GETS THE CURRENT VALUE OF OBLIST(THE ATOM)
2) HRRM C,RHX2 ;## ASSUMES THAT ALL REFERENCE TO OBLIST GOES
2) HRRM C,RHX5 ;## IE INTERN, REMOB ETC GOES THROUGH THIS SECTION.
2) POP P,C ;##RHX2 AND RHX5 ARE HOPEFULLY THE ONLY TWO WORDS
2) ;##WHICH ARE USED TO REFERENCE TABLE 3/28/73
2) HLRZ TT,@RHX2 ;get bucket
******** ILISP.MAC **** PAGE 4
1) 24300 MAKID4: HRRZ A,(A)
1) 24350 JUMPE A,NOPNAM ;no print name
1) 24400 MOVE A,(A)
1) 24450 HLRZ C,A
1) 24500 CAIE C,PNAME(S)
1) 24550 JRST MAKID4
1) 24600 MOVE C,IDPTR ;found pname
1) 24650 HLRZ A,(A)
1) 24700 MAKID5: JUMPE A,MAKID3 ;not the one
*** NEWUCI.MAC *** PAGE 2
2) MAKID4: MOVEI B,PNAME(S) ;## USE GET FOR GETTING PNAME
2) PUSHJ P,GET ;## (GET ATOM @PNAME)
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 4,2
2) JUMPE A,NOPNAM ;## NO PRINT NAME
2) MOVE C,IDPTR ;found pname
2) MAKID5: JUMPE A,MAKID3 ;not the one
******** ILISP.MAC **** PAGE 4
1) 34350 SUBTTL LISP INTERPRETER SUBROUTINES --- PAGE 10
1) 34400 PAGE
*** NEWUCI.MAC *** PAGE 2
2) PAGE
2) SUBTTL LISP INTERPRETER SUBROUTINES
2) PAGE
******** ILISP.MAC **** PAGE 4
1) 38450 CONSP: CAILE A,INUMIN
1) 38500 JRST FALSE
1) 38550 HLLE A,(A)
1) 38600 AOJE A,FALSE
1) 38650 JRST TRUE
1) 38700 PATOM: CAIL A,@GCP1
*** NEWUCI.MAC *** PAGE 2
2) CONSP: JUMPE A,CPOPJ ;## DONE IF NIL
2) CAILE A,INUMIN
2) JRST FALSE
2) HLLE B,(A)
2) AOJE B,FALSE
2) IFN NONUSE <JRST TRUE> ;## T IF NONUSEFUL DESIRED
2) IFE NONUSE <POPJ P,> ;## THE CELL OTHERWISE
2) PATOM: CAIL A,@GCP1
******** ILISP.MAC **** PAGE 4
1) 38950 HLLE A,(A)
*** NEWUCI.MAC *** PAGE 2
2) JUMPE A,TRUE ;## FAST CHECK FOR NIL
2) CAIGE A,@GCP1 ;## LO-END OF FWS, CAN'T ADD TO 0
2) HLLE A,(A)
******** ILISP.MAC **** PAGE 4
1) 39550 LNGTH1: CAILE A,INUMIN
1) 39600 JRST FIX1
*** NEWUCI.MAC *** PAGE 2
2) LNGTH1: CAIE A,NIL ;## DONE IF NIL
2) CAIL A,@FWSO ;## FWSO IS FULL SPACE ORIGIN,
2) ;## ELIMINATE ILL MEM REF
2) JRST FIX1
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 4,2
******** ILISP.MAC **** PAGE 4
1) 39950 CAILE B,INUMIN
1) 40000 POPJ P,
*** NEWUCI.MAC *** PAGE 2
2) CAIE B,NIL ;## IF NIL DONE
2) CAIL B,@FWSO ;## ANOTHER POTENTIAL ILL MEM GONE
2) POPJ P,
******** ILISP.MAC **** PAGE 4
1) 40750 RPLACA: CAILE A,INUMIN ;$$
1) 40800 JRST RPAERR ;$$ ATTEMPT TO RPLACA A SMALL NUMBER
*** NEWUCI.MAC *** PAGE 2
2) RPLACA: CAIE A,NIL ;## TEST FOR NIL
2) CAILE A,INUMIN ;$$
2) JRST RPAERR ;$$ ATTEMPT TO RPLACA A SMALL NUMBER
******** ILISP.MAC **** PAGE 4
1) 44350 GET: HRRZ A,(A)
1) 44400 MOVS D,(A)
1) 44450 CAIN B,(D)
*** NEWUCI.MAC *** PAGE 2
2) ;## IF WE ARE USING NEW NIL, THEN GET IS FOR SYSTEM ONLY AND
2) ;## USRGET IS THE USERS. IF NEW NIL, THEN GET MUST GET NIL'S
2) ;## PROPERTY LIST
2) IFE OLDNIL<
2) USRGET: JUMPE A,CPOPJ ;## ALWAYS NIL>
2) GET:
2) IFE OLDNIL< CAIE A,NIL
2) SKIPA A,NILPRP>
2) HRRZ A,(A)
2) GET1: MOVS D,(A)
2) CAIN B,(D)
******** ILISP.MAC **** PAGE 4
1) 44650 JUMPN A,GET+1
1) 44700 POPJ P,
1) 44800 GETL: JUMPE B,FALSE ;$$ NIL LIST - NIL ANSWER
1) 44850 HRRZ A,(A)
*** NEWUCI.MAC *** PAGE 2
2) JUMPN A,GET1
2) POPJ P,
2) GETL: JUMPE B,FALSE ;$$ NIL LIST - NIL ANSWER
2) IFE OLDNIL <JUMPE A,CPOPJ> ;## TEST FOR NIL
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 4,2
2) HRRZ A,(A)
******** ILISP.MAC **** PAGE 4
1) 46600 PUTPROP: MOVE T,A
1) 46650 HRRZ A,(A)
*** NEWUCI.MAC *** PAGE 2
2) PUTPROP:
2) IFN OLDNIL <MOVE T,A>
2) IFE OLDNIL <SKIPN T,A ;## CAN'T PUTPROP TO NIL
2) ERR1 [SIXBIT /CAN'T PUT PROP ON NIL !/]>
2) HRRZ A,(A)
******** ILISP.MAC **** PAGE 5
1) 00750 SUBS5: HRRZ A,SUBAS
*** NEWUCI.MAC *** PAGE 2
2) COMMENT ?
2) ;## OLD SUBST AND COPY CODE THAT DID NOT WORK AS IT WAS
2) ;## NOT PROTECTED FROM THE GARBAGE COLLECTOR. NASTY, NASTY.
2) ;## REPLACED BY COMPILED LISP CODE
2) SUBS5: HRRZ A,SUBAS
******** ILISP.MAC **** PAGE 5
1) 01350 CAILE C,INUMIN
*** NEWUCI.MAC *** PAGE 2
2) CAIE C,NIL ;## TEST FOR NIL
2) CAILE C,INUMIN
******** ILISP.MAC **** PAGE 5
1) 02400 ; NTHCHAR = THE BTH CHARACTER OF A.
*** NEWUCI.MAC *** PAGE 2
2) ?
2) ; NTHCHAR = THE BTH CHARACTER OF A.
******** ILISP.MAC **** PAGE 5
1) 06050 MEMBER: MOVEM A,SUBAS
1) 06100 MEMB1: JUMPE B,FALSE
1) 06150 MOVEM B,SUBBS
1) 06200 MOVE A,SUBAS
*** NEWUCI.MAC *** PAGE 2
2) IFN NONUSE<MEMBER:
2) >
2) MEMB0: MOVEM A,SUBAS#
2) MEMB1: JUMPE B,FALSE
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 5,2
2) MOVEM B,SUBBS#
2) MOVE A,SUBAS
******** ILISP.MAC **** PAGE 5
1) 06600 MEMQ: JUMPE B,FALSE
1) 06650 MOVS C,(B)
1) 06700 CAIN A,(C)
1) 06750 JRST TRUE
1) 06800 HLRZ B,C
1) 06850 JUMPN B,MEMQ+1
1) 06900 JRST FALSE
1) 07100 ;NEW MEM-FUNCTIONS THAT RETURN THE TAIL OF THE LIST STARTING WHERE
1) 07150 ; THE ELEMENT IS FOUND
1) 07250 MEMBR.: PUSHJ P,MEMBER
1) 07300 SKIPE A
*** NEWUCI.MAC *** PAGE 2
2) IFE NONUSE<MEMQ:
2) >
2) MEMB: EXCH A,B ;## NEW MEMQ THAT RETURN TAIL
2) JUMPE A,FALSE
2) MOVS C,(A)
2) CAIN B,(C)
2) POPJ P,
2) HLRZ A,C
2) CAMGE A,FWSO ;##THIS WILL ELIMINATE MOST (MAYBE ALL)
2) ;## ILLEGAL MEM REFS FROM MEMQ
2) ;##AND ASSOCIATED ROUTINES. FWSO IS FWS ORIGIN
2) JUMPN A,MEMQ+1
2) POPJ P,
2) ;NEW MEM-FUNCTIONS THAT RETURN THE TAIL OF THE LIST STARTING WHERE
2) ; THE ELEMENT IS FOUND
2) IFE NONUSE<MEMBER:
2) >
2) MEMBR.: PUSHJ P,MEMB0
2) SKIPE A
******** ILISP.MAC **** PAGE 5
1) 07500 MEMB: PUSHJ P,MEMQ
1) 07550 SKIPE A
1) 07600 MOVE A,B
1) 07650 POPJ P,
1) 07800 ;NEW AND AND OR FUNCTIONS (AND#, OR#) THAT RETURN THE EXPRESSION
1) 07850 ; THAT CAUSED THE FUNCTION TO EVALUATE TO TRUE
*** NEWUCI.MAC *** PAGE 2
2) IFN NONUSE<
2) MEMQ: PUSHJ P,MEMB
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 5,2
2) SKIPE A
2) JRST TRUE
2) POPJ P,
2) ;AND OR FUNCTIONS (AND#, OR#) THAT RETURN THE EXPRESSION
2) ; THAT CAUSED THE FUNCTION TO EVALUATE TO TRUE
******** ILISP.MAC **** PAGE 5
1) 08250 AND:
*** NEWUCI.MAC *** PAGE 2
2) >
2) AND:
******** ILISP.MAC **** PAGE 5
1) 09200 SKIPE A
1) 09250 MOVEI A,TRUTH(S)
1) 09300 POPJ P,
*** NEWUCI.MAC *** PAGE 2
2) IFN NONUSE <
2) SKIPE A
2) MOVEI A,TRUTH(S)
2) >
2) POPJ P,
******** ILISP.MAC **** PAGE 5
1) 16250 HLRZ TT,(A)
1) 16300 HRRZ A,(A)
1) 16350 HRRM A,PA4
*** NEWUCI.MAC *** PAGE 2
2) HLRZ TT,(A) ;## TT HAS VARIABLE LIST
2) HRRZ A,(A) ;## A HAS PROG BODY
2) HRRM A,PA4
******** ILISP.MAC **** PAGE 5
1) 17200 JUMPE T,PG4
1) 17250 HLRZ A,(T)
1) 17300 HRRZ T,(T)
1) 17350 HLLE B,(A)
1) 17400 AOJE B,PG1+1
1) 17450 HRRM T,PA4
1) 17550 PUSH P,SP ;$$SAVE SPDL TO RESTORE AFTER EVAL
1) 17600 PUSHJ P,EVAL
1) 17650 POP P,SP ;$$RESTORE SPDL AFTER EVAL
1) 17750 JRST PG1
1) 17850 PGO: SKIPN PA3
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 5,2
1) 17900 JRST EG2
1) 17950 MOVE P,PA3
1) 18000 MOVE B,1(P)
1) 18050 PUSHJ P,UBD
1) 18100 HLRZ T,PA4
1) 18150 PG5: JUMPE T,EG1
1) 18200 HLRZ TT,(T)
1) 18250 HRRZ T,(T)
1) 18300 CAIN TT,(A)
1) 18350 JRST PG1+1 ;FOUND TAG
1) 18400 JRST PG5
1) 18450
*** NEWUCI.MAC *** PAGE 2
2) JUMPE T,PG4 ;## IF END OF PROG, QUITE
2) HLRZ A,(T) ;## A HAS FIRST STATEMENT
2) HRRZ T,(T) ;## T KEEPS THE REST
2) CAIE A,NIL ;## TEST FOR NIL
2) CAILE A,INUMIN ;## ALLOW INUMS FOR PROG LABELS 3/28/73
2) JRST PG1+1 ;## NOW WE CAN SKIP OVER THIS TYPE OF ATOM
2) HLLE B,(A) ;## IS IT A ATOM?
2) AOJE B,PG1+1 ;## JA, SO JUMP
2) HRRM T,PA4 ;## SAVE REST OF BODY
2) PUSH P,SP ;$$SAVE SPDL TO RESTORE AFTER EVAL
2) PUSHJ P,EVAL ;## EVAL THE STATEMENT
2) POP P,SP ;$$RESTORE SPDL AFTER EVAL
2) JRST PG1
2) PGO: SKIPN PA3 ;## ERROR IF NO PROG
2) JRST EG2
2) MOVE P,PA3 ;## BACK UP ON RPDL
2) MOVE B,1(P) ;## GET FORM
2) PUSHJ P,UBD
2) HRLZI C,(POPJ P,) ;## NEW CODE TO ALLOW BREAKING
2) ;## AND TRACING OF GO
2) PUSHJ P,DOSET ;##
2) HLRZ T,PA4
2) PG5: JUMPE T,EG1 ;## ERROR IF NO TAG FOUND
2) HLRZ TT,(T) ;## GET THE CAR
2) HRRZ T,(T) ;## SAVE UP THE REST OF THE BODY
2) CAIN TT,(A)
2) JRST PG1+1 ;FOUND TAG
2) JRST PG5 ;## TRY AGAIN
2)
******** ILISP.MAC **** PAGE 5
1) 18750 JRST PG4+1
1) 18800 PG4: SETZ A,
*** NEWUCI.MAC *** PAGE 2
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 5,2
2) HRLZI C,(POPJ P,) ;## NEW CODE TO ALLOW BREAKING
2) ;## AND TRACING OF RETURN
2) PUSHJ P,DOSET ;##
2) JRST PG4+1
2) PG4: SETZ A,
******** ILISP.MAC **** PAGE 5
1) 19150 HLLE B,(A)
1) 19200 AOJE B,PGO
*** NEWUCI.MAC *** PAGE 2
2) CAIE A,NIL ;## TEST FOR NIL
2) CAILE A,INUMIN ;## IS IT AN INUM?(NOW VALID)
2) JRST PGO ;## SEE IF IT IS THE ONE
2) HLLE B,(A) ;## IS IT AN ATOM
2) AOJE B,PGO
******** ILISP.MAC **** PAGE 5
1) 23350 SUBTTL ARITHMETIC SUBROUTINES --- PAGE 11
1) 23450 ;macro expander -- (foo a b c) => (*foo (*foo a b) c)
*** NEWUCI.MAC *** PAGE 2
2) SUBTTL ARITHMETIC SUBROUTINES
2) ;macro expander -- (foo a b c) => (*foo (*foo a b) c)
******** ILISP.MAC **** PAGE 5
1) 26950 CAIN B,FIXNUM(S)
1) 27000 JRST FIX1A
*** NEWUCI.MAC *** PAGE 2
2) CAIE B,FLONUM(S) ;## DEFAULT TO FIXNUM, NOT FLONUM
2) JRST FIX1A
******** ILISP.MAC **** PAGE 5
1) 30200 PAGE
*** NEWUCI.MAC *** PAGE 2
2) NUMTYP: PUSHJ P,NUMVAL ;## NUMVAL LEAVES TYPE IN B
2) MOVEI A,(B) ;## GET THE TYPE
2) POPJ P,
2) INUMP: CAIG A,INUMIN ;## INUM IF > INUMIN
2) JRST FALSE ;## NO, RETURN NIL
2) POPJ P, ;## RETURN USEFUL VALUE
2) PAGE
******** ILISP.MAC **** PAGE 5
1) 33600 MOVE AR1,A
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 5,2
1) 33650 JFCL 17,.+1
*** NEWUCI.MAC *** PAGE 2
2) JFCL 17,.+1
******** ILISP.MAC **** PAGE 5
1) 00050 SUBTTL EXPLODE, READLIST AND FRIENDS --- PAGE 12
1) 00150 %FLATSIZEC: SKIPA R,.+1 ;$$ FLATSIZEC - (LENGTH (EXPLODEC))
*** NEWUCI.MAC *** PAGE 2
2) PAGE
2) SUBTTL EXPLODE, READLIST AND FRIENDS
2) %FLATSIZEC: SKIPA R,.+1 ;$$ FLATSIZEC - (LENGTH (EXPLODEC))
******** ILISP.MAC **** PAGE 7
1) 01800 SUBTTL EVAL APPLY -- THE INTERPRETER --- PAGE 13
1) 01850 EV3: HLRZ A,(AR1)
*** NEWUCI.MAC *** PAGE 2
2) PAGE
2) SUBTTL EVAL APPLY -- THE INTERPRETER
2) EV3: HLRZ A,(AR1)
******** ILISP.MAC **** PAGE 7
1) 00050 SUBTTL ARRAY SUBROUTINES --- PAGE 14
1) 00150 ARRERR=-1
*** NEWUCI.MAC *** PAGE 2
2) PAGE
2) SUBTTL ARRAY SUBROUTINES
2) ARRERR=-1
******** ILISP.MAC **** PAGE 8
1) 06750 EXARRAY: PUSH P,A
*** NEWUCI.MAC *** PAGE 2
2) GTBLK: MOVNI C,-INUM0(A) ;##COMPUTE NEGATIVE LENGTH
2) MOVE A,VBPORG(S) ;## GET BPORG
2) HRRI A,-INUM0(A) ;## CONVERT
2) HRLM C,(A) ;## MOVE TO BPORG INFO FOR (GC)
2) HRRM A,(A) ;##
2) AOS R,(A) ;## ADD ONE TO INFO AND MOVE TO R
2) SUBI R,1 ;## SET PUSH DOWN POINTER(ASSUME POINTER BLOCK)
2) CAIN B,0 ;## IS IT A POINTER BLOCK?
2) SUBI R,1 ;## NO
2) MOVE AR1,VBPEND(S) ;## GET BPEND
2) MOVNI AR1,-INUM0(AR1) ;## CONVERT TO NEGATIVE
2) ADD AR1,R ;## BPORG-BPEND +(0 OR 1)
2) HRLI R,(AR1) ;## MOVE TO R FOR TESTING FOR BPS EXCEEDED
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 8,2
2) PUSH R,[0] ;## CLEAR THE SPACE, NOTE THAT IF IT IS NOT
2) AOJN C,.-1 ;## WE WILL ALSO CLEAR THE INFO LOCATION
2) HRRZI R,INUM0+1(R) ;## COMPUTE NEW BPORG
2) HRRM R,VBPORG(S)
2) CAIN B,0 ;## IF IT WAS NOT A POINTER BLOCK, DONE
2) POPJ P,
2) MOVE B,GCMKL ;## GET GC'S LIST
2) PUSHJ P,CONS ;## CONS
2) MOVEM A,GCMKL ;## SAVE IT
2) HLRZ A,(A) ;GET THE OLD BPORG BACK
2) AOJA A,.-5 ;## ADD ONE AND RETURN
2) BLKLST: PUSH P,A ;## SAVE LIST
2) CAIE B,0 ;## BLK LENGTH GIVEN
2) SKIPA A,B ;## YES
2) PUSHJ P,LENGTH ;## NO, USE LENGTH OF LIST
2) MOVEI B,(A) ;## GET A POINTER BLOCK FROM GTBLK
2) PUSHJ P,GTBLK
2) POP P,B ;## GET LIST BACK
2) PUSH P,A
2) HRRZI R,-1(A) ;## SET UP PDL
2) HLRE C,(R) ;## NEG LENGTH FROM GC INFO.
2) BLKLS1: HRRI A,1(A) ;## BUMP A FOR CDR
2) IFN OLDNIL< ;## IF(CDR NIL)#NIL
2) TRNE B,-1 ;## END OF LIST?
2) SKIPA B,(B) ;## NO
2) SETZ B, ;## YES, REST OF BLOCK IS NIL
2) >
2) IFE OLDNIL<
2) MOVE B,(B) ;## IF (CDR NIL )=NIL
2) >
2) HLL A,B ;## GET (CAR LIST)
2) PUSH R,A ;## AND STORE
2) AOJL C,BLKLS1 ;## SEE IF DONE
2) HLLZM A,(R) ;## SET (CDR (LAST BLOCK)) TO NIL
2) JRST POPAJ ;## AND RETURN POINTER TO THE BLOCK
2) EXARRAY: PUSH P,A
******** ILISP.MAC **** PAGE 9
1) 00050 SUBTTL EXAMINE, DEPOSIT , ETC --- PAGE 15
1) 00150 BOOLE: MOVE TT,T
*** NEWUCI.MAC *** PAGE 2
2)
2) PAGE
2) SUBTTL EXAMINE, DEPOSIT , ETC
2) BOOLE: MOVE TT,T
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 9,2
******** ILISP.MAC **** PAGE 9
1) 00050 SUBTTL GARBAGE COLLECTER --- PAGE 16
1) 00150 ;garbage collector
*** NEWUCI.MAC *** PAGE 2
2) PAGE
2) SUBTTL GARBAGE COLLECTER
2) ;garbage collector
******** ILISP.MAC **** PAGE 10
1) 00600 PUSH P,UBDPTR ;special atom UNBOUND; not on OBLIST
*** NEWUCI.MAC *** PAGE 2
2) IFE OLDNIL <PUSH P,NILPRP ;## PROP LIST OF NIL>
2) PUSH P,UBDPTR ;special atom UNBOUND; not on OBLIST
******** ILISP.MAC **** PAGE 10
1) 00850 GCPK2: PUSH P,[XWD 0,GCP6] ;this is a return address
*** NEWUCI.MAC *** PAGE 2
2) PUSH P,INITF1 ;## INIT FILE LIST
2) GCPK2: PUSH P,[XWD 0,GCP6] ;this is a return address
******** ILISP.MAC **** PAGE 10
1) 00050 SUBTTL GETSYM --- PAGE 17
1) 00150 R50MAK: PUSHJ P,PNAMUK
*** NEWUCI.MAC *** PAGE 2
2)
2) PAGE
2) SUBTTL SYMBOL TABLE ACCESSING ROUTINES
2) R50MAK: PUSHJ P,PNAMUK
******** ILISP.MAC **** PAGE 11
1) 00850 GETSYM: PUSHJ P,R50MAK
*** NEWUCI.MAC *** PAGE 2
2) ;## NEW ROUTINES FOR CONVERTING SYMBOLS TO CONS CELL
2) SYMERR: MOVE A,B
2) SYMER1: PUSHJ P,EPRINT ;## PRINT OFFENDER
2) ERR1 [SIXBIT /NOT A CONS CELL !/]
2) ;## **CAUSES ERROR IF NOT IN FREE STORAGE**
2) RGTSYM: PUSHJ P,GETSYM
2) PUSHJ P,NUMVAL ;## CONVERT TO REAL ADDRESS
2) ADDI A,(S) ;## ADD RELOCATION
2) CAIL A,FS(S) ;## LESS THAN FS(S) IS NOT CONS CELL
2) CAML A,FWSO ;## FS(S)<= A < FWSO IS A CONS CELL
2) JRST SYMER1
2) POPJ P,
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 11,2
2) GETSYM: PUSHJ P,R50MAK
******** ILISP.MAC **** PAGE 11
1) 01600 PUTSYM: PUSH P,B
*** NEWUCI.MAC *** PAGE 2
2) ;## ROUTINE TO STORE A CONS CELL SO THAT IT CAN BE
2) ;## REFERENCED VIA ,CELL(S) I.E. THRU INDEX REG. S
2) ;## ERROR IF NOT LEGITIMATE CONS CELL
2) RPTSYM: CAIL B,FS(S) ;## FS(S) =< B <FWSO IS A LEGIT
2) CAML B,FWSO ;## CONS CELL, ALL ELSE IS ERROR
2) JRST SYMERR ;## ERROR
2) SUBI B,(S) ;## STRIP OF RELOCATION
2) PUTSYM: PUSH P,B
******** ILISP.MAC **** PAGE 11
1) 00050 SUBTTL ALVINE AND LOADER INTERFACES --- PAGE 18
1) 00150 ;interface to alvine
1) 00250 IFN ALVINE,<
1) 00300 ED: MOVE 10,EDA
1) 00350 JRST (10)
1) 00400 PUSH P,A
1) 00450 HRRZ A,CORUSE
1) 00500 HRRM A,LST
1) 00550 AOS A
1) 00600 HRRM A,EDA#
1) 00750 HRRM A,ED1 ;$$SAVE REENTRY TO EDITOR
1) 00800 AOS ED1# ;$$
1) 00900 MOVSI A,(SIXBIT /ED/)
1) 00950 SETZ D, ;THAT RELOCATION AGAIN - SEE BELOW
1) 01000 PUSHJ P,SYSINI
1) 01050 HRLM A,LST
1) 01100 MOVNS A
1) 01150 PUSHJ P,MORCOR
1) 01200 PUSHJ P,SYSINP+1
1) 01250 POP P,A
1) 01300 JRST ED
1) 01350 GRINDEF:PUSH P,A
1) 01400 PUSHJ P,ED
1) 01450 POP P,A
1) 01500 JRST 2(10)>
1) 01600 EXCISE:
1) 01650 IFN ALVINE<
1) 01700 MOVEI A,ED+2
1) 01750 HRRM A,EDA>
1) 01800 MOVE A,JRELO
1) 01850 SETZM LDFLG# ;initial loader symbol table flag
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 11,2
1) 01900 CALLI A,CORE
1) 01950 JRST .+1
1) 02000 JSP R,IOBRST
1) 02050 JRST TRUE
1) 02150 PAGE
1) 02200 ;THIS IS THE NEW IMPROVED VERSION OF SPRINT
*** NEWUCI.MAC *** PAGE 2
2) PAGE
2) SUBTTL SPRINT -- THE PRETTY PRINTER
2) ;THIS IS THE NEW IMPROVED VERSION OF SPRINT
******** ILISP.MAC **** PAGE 12
1) 22000 ; lisp loader interface
*** NEWUCI.MAC *** PAGE 2
2) SUBTTL ALVINE AND LOADER INTERFACES
2) ;interface to alvine
2) IFN ALVINE,<
2) ED: MOVE 10,EDA
2) JRST (10)
2) PUSH P,A
2) HRRZ A,CORUSE
2) HRRM A,LST
2) AOS A
2) HRRM A,EDA#
2) HRRM A,ED1 ;$$SAVE REENTRY TO EDITOR
2) AOS ED1# ;$$
2) MOVSI A,(SIXBIT /ED/)
2) SETZ D, ;THAT RELOCATION AGAIN - SEE BELOW
2) PUSHJ P,SYSINI
2) HRLM A,LST
2) MOVNS A
2) PUSHJ P,MORCOR
2) PUSHJ P,SYSINP+1
2) POP P,A
2) JRST ED
2) GRINDEF:PUSH P,A
2) PUSHJ P,ED
2) POP P,A
2) JRST 2(10)>
2) EXCISE:
2) IFN ALVINE<
2) MOVEI A,ED+2
2) HRRM A,EDA>
2) MOVE A,JRELO
2) SETZM LDFLG# ;initial loader symbol table flag
2) CALLI A,CORE
2) JRST .+1
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 12,2
2) JSP R,IOBRST
2) JRST TRUE
2) PAGE
2) ; lisp loader interface
******** ILISP.MAC **** PAGE 12
1) 26000 HRLM C,JOBSA
1) 26050 CALLI C,CORE ;contract core
*** NEWUCI.MAC *** PAGE 2
2) CALLI C,CORE ;contract core
******** ILISP.MAC **** PAGE 12
1) 26700 IFN SYSPRG,< MOVE A,[XWD SYSPRG,SYSPN]
*** NEWUCI.MAC *** PAGE 2
2) ;%% FOLLOWING IS OLD, NON-PATCHABLE CHANNEL OPEN
2) COMMENT &
2) IFN SYSPRG,< MOVE A,[XWD SYSPRG,SYSPN]
******** ILISP.MAC **** PAGE 12
1) 27050 LOOKUP NAME(D)
*** NEWUCI.MAC *** PAGE 2
2) & ;%% END OF OLD CODE
2) ;%% NEW PATCHABLE CODE (DEVICE NAME IN LOW SEGMENT)
2) MOVE A,SYSIN1(D) ;%% PICK UP PPN
2) REMOTE<
2) SYSIN1: XWD SYSPRG,SYSPN ;%% KEEP IN LOW SEGMENT
2) >
2) MOVEM A,NAME+3(D) ;%% RESET VALUE HERE
2) MOVEI A,17 ;%% SET DATA MODE
2) MOVEM A,SYSIN0(D) ;%%
2) OPEN 0,SYSIN0(D) ;%% OPEN CHANNEL 0 TO READ FILE
2) JRST AIN.4+1 ;%% ERROR IN OPEN IF HERE
2) REMOTE<
2) SYSIN0: 17 ;%% DUMP MODE I/O
2) SYSDEV ;%% INITIALLY SYSTEM DEVICE
2) ;%% MAY BE PATCHED
2) ;%% NOTE THAT THIS MAY REMAIN "SYS"
2) ;%% WHEN HGHDAT IS CHANGED TO
2) ;%% SOMETHING ELSE
2) 0 ;%% NO BUFFERING
2) >
2) LOOKUP NAME(D)
******** ILISP.MAC **** PAGE 12
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 12,2
1) 27700 NAME: SIXBIT/ILISP/
1) 27750 0
*** NEWUCI.MAC *** PAGE 2
2) NAME: SYSNAM
2) 0
******** ILISP.MAC **** PAGE 12
1) 28500 MOVDWN: HLRZ A,JOBSYM
1) 28550 JUMPE A,MOVS1
*** NEWUCI.MAC *** PAGE 2
2) MOVDWN: HRLM B,JOBSA ;##SAVE NEW JOBSA
2) HLRZ A,JOBSYM
2) JUMPE A,MOVS1
******** ILISP.MAC **** PAGE 12
1) 30250 SUBM A,B
1) 30300 JUMPL B,EXPND2
*** NEWUCI.MAC *** PAGE 2
2) SUBM A,B ;NEEDED-JOBSYM-CORUSE(IE. NEEDED-FREE)
2) JUMPL B,EXPND2
******** ILISP.MAC **** PAGE 12
1) 31650 IFE STANSW,< HRLZ A,B
1) 31700 CALLI A,CORE >
1) 31750 IFN STANSW,< HRRZ A,B
1) 31800 CALLI A,400015>
1) 31850 ERR1 [SIXBIT /CAN'T EXPAND HIGH SEGMENT!/]
*** NEWUCI.MAC *** PAGE 2
2) HRLZ A,B
2) CALLI A,CORE
2) ERR1 [SIXBIT /CAN'T EXPAND HIGH SEGMENT!/]
******** ILISP.MAC **** PAGE 12
1) 33100 PUSHJ P,IOSUB ;BREAKS DOWN THE SPECIFICATION
1) 33150 CAME A,[SYSNAM] ; *** MJC
1) 33200 ; We're not allowing him to name his segment the same as ours, *** MJC
1) 33250 ; since that causes problems for ATTSEG, so test for it. *** MJC
1) 33300 JRST GUDSEG ; *** MJC
1) 33350 MOVE B,[SYSDEV] ; But if he's a system hacker *** MJC
1) 33400 CAME B,DEV ; then we let him get away *** MJC
1) 33450 JRST BADSEG ; with it. *** MJC
1) 33500 GUDSEG: MOVEM A,HGHDAT+1 ;SAVE THE FILE NAME
1) 33550 MOVE A,DEV ;GET THE DEVICE AND SAVE IT
1) 33600 MOVEM A,HGHDAT
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 12,2
1) 33650 MOVEM A,INTDAT+1 ; Save it for OPEN, too. *** MJC
1) 33700 MOVE A,PPN ;GET THE PPN AND SAVE IT
1) 33750 MOVEM A,SGPPPN ; *** MJC
1) 33800 MOVEM A,HGHDAT+4
1) 33850 SKIPN A,EXT ; Get extension and save it. *** MJC
1) 33900 MOVE A,[SIXBIT/SEG/] ; No ext -- use SEG instead. *** MJC
1) 33950 MOVEM A,HGHDAT+2 ; Move ext into OPEN stuff. *** MJC
1) 34000 OPEN 0,INTDAT ; Open for dump output. *** MJC
1) 34050 JRST BADSEG ; Couldn't open? *** MJC
1) 34100 ENTER 0,HGHDAT+1 ; Hookup to file. *** MJC
1) 34150 JRST BADSEG ; Couldn't do it? *** MJC
1) 34200 CALLI A,400022 ; Find size of high segment. *** MJC
1) 34250 MOVNS A ; Construct dump mode cmd wd. *** MJC
1) 34300 HRLM A,HGHDAT+4 ; I.e. -length to left half *** MJC
1) 34350 MOVEI A,SHRST-1 ; and <start>-1 to rt half. *** MJC
1) 34400 HRRM A,HGHDAT+4 ; *** MJC
1) 34450 OUTPUT 0,HGHDAT+4 ; *** MJC
1) 34500 CLOSE 0,2 ; Leave no traces *** MJC
1) 34550 JRST FALSE ;RETURN NIL
1) 34600 BADSEG: ERR1 [SIXBIT/ILLEGAL NAME FOR SEGMENT!/] ; *** MJC
1) 34650 JRST FALSE ; *** MJC
1) 34750 REMOTE<WRTSTS: 1>
1) 34800 PAGE
1) 34850 SUBTTL REALLOC CODE --- PAGE 19
1) 34950 STRT:
*** NEWUCI.MAC *** PAGE 2
2) SETZM DEV ;## ALLOW DEFAULT TO DSK:
2) PUSHJ P,IOSUB ;BREAKS DOWN THE SPECIFICATION
2) MOVEM A,HGHDAT+1 ;SAVE THE FILE NAME
2) MOVE A,DEV ;GET THE DEVICE AND SAVE IT
2) MOVEM A,HGHDAT
2) MOVE A,PPN ;GET THE PPN AND SAVE IT
2) MOVEM A,HGHDAT+4
2) JRST FALSE ;RETURN NIL
2) REMOTE<WRTSTS: 1>
2) PAGE
2) SUBTTL REALLOC CODE
2) STRT:
******** ILISP.MAC **** PAGE 12
1) 44500 HRRM B,GCP5 ;TOP OF BIT TABLES
1) 44550 ADDI B,1 ;BOTTOM OF REG PDL
1) 44650 HRRZ A,RHX2 ;GET OBLIST POINTER
1) 44700 ADD A,FSMOVE ;INCREMENT TO
*** NEWUCI.MAC *** PAGE 2
2) HRRM B,GCP5 ;TOP OF BIT TABLES
2) ADDI B,1 ;BOTTOM OF REG PDL
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 12,2
2) MOVE S,ATMOV ;## S NOT SET IF LISP STARTED WITH CORE
2) ;## ALREADY EXPANDED, SO RESET IT
2) HRRZI A,OBTBL(S) ;GET OBLIST POINTER
2) ;## RHX2 IS NO LONGER PURE, WE WANT THE SYSTEM OBLIST
2) ;## THIS IS IT (I HOPE)3/28/73
2) ADD A,FSMOVE ;INCREMENT TO
******** ILISP.MAC **** PAGE 12
1) 49100 SKIPE NOUUOF ;RELOCATE FLAGS
*** NEWUCI.MAC *** PAGE 2
2) SKIPE INITF1 ;## DON'T FORGET THE INIT FILES
2) ADDM FF,INITF1 ;##
2) SKIPE NOUUOF ;RELOCATE FLAGS
******** ILISP.MAC **** PAGE 12
1) 50500 ADDM A,XXX1 ;AND SOMEOTHER CRAP
1) 50550 ADDM A,XXX2
1) 50600 ADDM A,XXX3
1) 50650 ADDM A,XXX4
1) 50700 ADDM A,XXX5
1) 50750 MOVE A,GCP1
*** NEWUCI.MAC *** PAGE 2
2) IFE OLDNIL< ADDM A,NILPRP> ;## RESET NIL
2) HRR B,VOBLIST(S) ;## GET CURRENT VALUE OF OBLIST
2) HRRM B,RHX5 ;## RESET WORD THAT POSTINDEXES OFF B
2) HRRM B,RHX2 ;## RESET WORD POSTINDEXING OFF C
2) ADDM A,XXX3 ;## RESET WIERD CODE
2) ADDM A,XXX4 ;## RESET UNBOUND
2) ADDM A,XXX5 ;## RESET FS (SAME WORD AS FS),ALSO GCPP1
2) MOVE A,GCP1
******** ILISP.MAC **** PAGE 13
1) 00950 BANGCK: CAIE C,LF
1) 01000 JRST (R)
*** NEWUCI.MAC *** PAGE 2
2) BANGCK: CAIE C,CR ;## TERMINATE ON CR,NOT LF
2) JRST (R)
******** ILISP.MAC **** PAGE 13
1) 09850 LALL
1) 09900 PAGE
1) 09950 SUBTTL LOW SETMENT INCLUDING REMOTE CODE
1) 10000 RELOC 0
*** NEWUCI.MAC *** PAGE 2
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 13,2
2) PAGE
2) SUBTTL LOW SEGMENT INCLUDING REMOTE CODE
2) RELOC 0
******** ILISP.MAC **** PAGE 13
1) 10250 SUBTTL LISP ATOMS AND OBLIST --- PAGE 20
1) 10300 FS:
*** NEWUCI.MAC *** PAGE 2
2) SUBTTL LISP ATOMS AND OBLIST
2) FS:
******** ILISP.MAC **** PAGE 13
1) 11700 DEFINE MKAT (A,B,C,D)
*** NEWUCI.MAC *** PAGE 2
2) ;## ARGS ARE A=NAME, B=PROP NAME, C'A=THE PROPERTY, D=LABEL OF ATOM
2) DEFINE MKAT (A,B,C,D)
******** ILISP.MAC **** PAGE 13
1) 12200 DEFINE MKAT1 (A,B,C,D)
*** NEWUCI.MAC *** PAGE 2
2) ;## ARGS ARE: D'A=PROPERTY, B=PROP NAME, C=NAME
2) DEFINE MKAT1 (A,B,C,D)
******** ILISP.MAC **** PAGE 13
1) 12800 DEFINE ML1 (A)<IRP A,<
*** NEWUCI.MAC *** PAGE 2
2) ;## ATOM WITH SYM PROPERTY =V'ATOM LOCATION
2) DEFINE ML1 (A)<IRP A,<
******** ILISP.MAC **** PAGE 13
1) 13100 DEFINE MKSY1 (A,B,%C)<
*** NEWUCI.MAC *** PAGE 2
2) ;## SIMILAR TO ML1, EXCEPT %C=THE SYM PROP
2) DEFINE MKSY1 (A,B,%C)<
******** ILISP.MAC **** PAGE 13
1) 13700 DEFINE ML (A)<
*** NEWUCI.MAC *** PAGE 2
2) ;## ATOM WITH NO PROPS WITH LABEL SAME AS ATOM NAME
2) DEFINE ML (A)<
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 13,2
******** ILISP.MAC **** PAGE 13
1) 14050 DEFINE MK (A)<
*** NEWUCI.MAC *** PAGE 2
2) ;## CREATE ATOM WITH NO LABEL OR PROPS. USED FOR COMMON ATMS IN SYSTEM
2) DEFINE MK (A)<
******** ILISP.MAC **** PAGE 13
1) 14850 MKAT<RPLACA,RPLACD,MINUS,TERPRI,READ,CAR,CDR,CAAR>,SUBR
1) 14900 MKAT<CADR,CDAR,CDDR,CAAAR,CAADR,CADAR,CADDR,CDAAR,CDADR,CDDAR,CDDDR>,SUBR
*** NEWUCI.MAC *** PAGE 2
2) ;## GENERATE # FNS ONLY IF NONUSEFUL VALUES DESIRED
2) IFN NONUSE<
2) MKAT1 MEMBR.,SUBR,MEMBER#
2) MKAT1 MEMB,SUBR,MEMQ#
2) MKAT1 AND.,FSUBR,AND#
2) MKAT1 OR.,FSUBR,OR#
2) >
2) MKAT<RPLACA,RPLACD,MINUS,TERPRI,CAR,CDR,CAAR>,SUBR
2) MKAT<CADR,CDAR,CDDR,CAAAR,CAADR,CADAR,CADDR,CDAAR,CDADR,CDDAR,CDDDR>,SUBR
******** ILISP.MAC **** PAGE 13
1) 15100 MKAT<GCGAG,CHRCT,LINELENGTH,NUMBERP,EQUAL,SUBST,GET,INTERN,MEMBER>,SUBR
1) 15150 MKAT<LOAD,MAKNAM,READCH,NOT,NULL,GENSYM,ZEROP,DIVIDE,GCD>,SUBR
*** NEWUCI.MAC *** PAGE 2
2) MKAT<GCGAG,CHRCT,LINELENGTH,NUMBERP,EQUAL,GET,INTERN,MEMBER>,SUBR
2) MKAT<LOAD,MAKNAM,READCH,NOT,NULL,GENSYM,ZEROP,DIVIDE,GCD>,SUBR
******** ILISP.MAC **** PAGE 13
1) 16300 MKAT <PROGN,LIST,COND,SETQ,INPUT,OUTPUT,SETSYS>,FSUBR
1) 16350 IFN ALVINE,<MKAT<GRINDEF>,FSUBR
*** NEWUCI.MAC *** PAGE 2
2) ;##LIST STARTS HERE
2) MKAT LIST,FSUBR,,LISTAT:
2) MKAT <PROGN,COND,SETQ,INPUT,OUTPUT,SETSYS>,FSUBR
2) IFN ALVINE,<MKAT<GRINDEF>,FSUBR
******** ILISP.MAC **** PAGE 13
1) 17050 MKAT EVAL,LSUBR,O
1) 17100 MKAT ASCII,SUBR,A
*** NEWUCI.MAC *** PAGE 2
2) ;## LABELS ON READ AND LISP EVAL FOR BOOTS
2) MKAT READ,SUBR,,READAT:
2) MKAT EVAL,LSUBR,O,EVALAT:
2) MKAT ASCII,SUBR,A
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 13,2
******** ILISP.MAC **** PAGE 13
1) 19300 ML1 <SPECBIND,SPECSTR,FIX1A,NSTR>
*** NEWUCI.MAC *** PAGE 2
2) MKAT1 RPTSYM,SUBR,*RPUTSYM
2) MKAT1 RGTSYM,SUBR,*RGETSYM
2) ML1 <SPECBIND,SPECSTR,FIX1A,NSTR>
******** ILISP.MAC **** PAGE 13
1) 20050 ;$$ATOMS FOR DEFINITIONS OF FUNCTIONS FOR NEW SPDL PACKAGE
*** NEWUCI.MAC *** PAGE 2
2) ;## QUEUE ATOMS AND OTHER NEW FNS.
2) MKAT<GTBLK,ERRCH,RDNAM>,SUBR
2) MKAT<INUMP,NUMTYPE>,SUBR
2) MKAT<UFDINP,RDFILE,MYPPN,BLKLST>,SUBR
2) MKAT<QUEUE,RENAME,DELETE,INITFL>,FSUBR
2) ML<CPU,FORMS,LIMIT,COPIES,DISP>
2) MK<SUBST,COPY,*RENAME,FILBAK,LBK,DIR>
2) MKAT1 ISFILE,SUBR,LOOKUP
2) MK<NO BACKUP >
2) ;## MOST OF THE EXTENDED SWITCHES (NOT ALL)
2) IFN QSWEXT<
2) ML<DEAD,AFTER>
2) ML<MODIFY,KILL,JOB,DEPND,UNIQUE>
2) ML<PAGES,PLOT,PTAPE,CARD,SEQ,PRIOR,SPACE,LIMIT,HEAD>
2) > ;##END OF EXTENDED SWITCHES
2) ;$$ATOMS FOR DEFINITIONS OF FUNCTIONS FOR NEW SPDL PACKAGE
******** ILISP.MAC **** PAGE 13
1) 20700 MKAT <NEQ,CONSP,CHRVAL,SETCHR,MODCHR,COPY,LEXORDER>,SUBR
1) 20750 MKAT <FREE,FREELIST,SYSCLR,HGHCOR,HGHORG,HGHEND>,SUBR
*** NEWUCI.MAC *** PAGE 2
2) MKAT <NEQ,CONSP,CHRVAL,SETCHR,MODCHR,LEXORDER>,SUBR
2) MKAT <FREE,FREELIST,SYSCLR,HGHCOR,HGHORG,HGHEND>,SUBR
******** ILISP.MAC **** PAGE 13
1) 21150 MKAT1 MEMBR.,SUBR,MEMBER#
1) 21200 MKAT1 MEMB,SUBR,MEMQ#
1) 21250 MKAT1 AND.,FSUBR,AND#
1) 21300 MKAT1 OR.,FSUBR,OR#
1) 21400 ;$$ THE BREAK VARIABLES WHICH TELL ABOUT DEPTH IN THE BREAK PACKAGE
*** NEWUCI.MAC *** PAGE 2
2) ;$$ THE BREAK VARIABLES WHICH TELL ABOUT DEPTH IN THE BREAK PACKAGE
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 13,2
******** ILISP.MAC **** PAGE 13
1) 22850 MK<A,ADD,AFTER,ALIAS,ARGPRINT,ASSOC#,ATM,B,BEFORE,BELOW,BEND1,BF,BI,BIND>
*** NEWUCI.MAC *** PAGE 2
2) MK<USERERRORX,RPUTSYM,RGETSYM>
2) MK<A,ADD,AFTER,ALIAS,ARGPRINT,ASSOC#,ATM,B,BEFORE,BELOW,BEND1,BF,BI,BIND>
******** ILISP.MAC **** PAGE 13
1) 24200 MK<REDEFINED,REMOVE,REPACK,REPLACE,RETFROM,RI,RO>
1) 24250 MK<S,SAVE,SECOND,SELECTQ,SN,SOJE,SOJN>
*** NEWUCI.MAC *** PAGE 2
2) MK<REDEFINED,REMOVE,REPACK,REPLACE,RETFROM,RI,RO> ;##REMOVE MARKER
2) MK<S,SAVE,SECOND,SELECTQ,SN,SOJE,SOJN>
******** ILISP.MAC **** PAGE 13
1) 26100 SUBTTL LISP STORAGE ALLOCATOR (ONCE ONLY) --- PAGE 21
1) 26250 ALLOC: CLEARM 0,SBPS ;SET UP INITIAL ALLOCATIONS FOR SPACE
*** NEWUCI.MAC *** PAGE 2
2) SUBTTL LISP STORAGE ALLOCATOR (ONCE ONLY)
2) ALLOC: CLEARM 0,SBPS ;SET UP INITIAL ALLOCATIONS FOR SPACE
******** ILISP.MAC **** PAGE 13
1) 28200 MKENT <EVBIG,NUMBP2,OPOV,NUMV2,NUMV3,NUMV4,OPR,FLOOV,FIX2>
1) 28250 MKENT <NUM1,NUM3,BPR,FWCONS,FALSE,TRUE,FW0CNS,NCONS>
1) 28300 MKENT <READ,READP1,MAKNUM,PRIN1,PRINT,EXPLODE,SASSOC,EQUAL,SUBST>
1) 28350 MKENT <CHCT,LINL,OLDCH,FLATSIZE,TYI,RATOM,CHRCT,TYOD>
*** NEWUCI.MAC *** PAGE 2
2) ;##DEBUG QUEUE
2) MKENT <CADAR,ATMOV,CADAR,COPIES,CORUSE,DEBUGO,DEV>
2) MKENT <EXT,HGHDAT,INUM0,INUMIN,IOPPN,LISTAT,MORCOR,MOVDWN>
2) MKENT <NXTIO,OLDCU,SIXMAK,STNIL>
2) MKENT <EVBIG,NUMBP2,OPOV,NUMV2,NUMV3,NUMV4,OPR,FLOOV,FIX2>
2) MKENT <NUM1,NUM3,BPR,FWCONS,FALSE,TRUE,FW0CNS,NCONS>
2) MKENT <READ,READP1,MAKNUM,PRIN1,PRINT,EXPLODE,SASSOC,EQUAL>
2) MKENT <CHCT,LINL,OLDCH,FLATSIZE,TYI,RATOM,CHRCT,TYOD>
******** ILISP.MAC **** PAGE 13
1) 28950 ;$$ FOR ALVINE
1) 29000 MKENT <PROMPT,INUM0,MEMQ,UNBOUND>
1) 29100 PAGE
1) 29150 END ALLOC
*** NEWUCI.MAC *** PAGE 2
2) ;## FOR BILL'S DIRECT ACCESS INPUT/OUTPUT
2) MKENT <AIN.2,AIN.4,AIN.7,AOUT.2,CHANNE>
1) ILISP.MAC vs. 2) NEWUCI.MAC SRCCOM 12-11-73 11:08 PAGES 13,2
2) MKENT <CHNSUB,CHTAB,DEVDAT,ENTR,IOSUB>
2) MKENT <LOOKIN,OUTCH,OUTERR,POPAJ,PPN,SMAC>
2) MKENT <TABSR1,TABSRC,TYI2E,TYI2Z,TYI3B,TYO2X>
2) MKENT <TYO5,AIOP,SETIN>
2) ;$$ FOR ALVINE
2) MKENT <PROMPT,INUM0,MEMQ,UNBOUND>
2) ;%% FOR THE MODIFIED ARITHMETIC PACKAGE
2) MKENT <FIXNUM,FLONUM>
2) PAGE
2) END ALLOC